如何將過濾的範圍複製到數組中？（EXCEL VBA）

你怎麼把過濾後的結果爲在Excel VBA中的數組我用這個公式來從列A複製的獨特記錄到B列如何將過濾的範圍複製到數組中？（EXCEL VBA）

Range("A1", Range("A100").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True

，而不要照搬入列B的？

來源

2012-08-16 phan

有沒有內置的方法。您可以將其複製到臨時位置（例如隱藏表格），並從那裏轉移到陣列。 – 2012-08-16 21:45:20

好的。有沒有辦法只使用代碼而不是隱藏工作表上的單元格完成相同的結果？也就是說，結果是在範圍A1：A100中找到所有唯一記錄（避免重複值）並將其放入數組中。 – phan 2012-08-16 21:50:21

你會想Read this，它會指向您在正確的方向

它說：

使用AdvancedFilter方法在工作表中的一些未使用的空間，創造了過濾範圍
將該範圍的Value屬性賦值給Variant以創建一個二維數組
使用ClearContents方法的t帽子範圍內擺脫它

來源

2012-08-16 22:05:26 Sorceri

請發佈步驟或至少是此鏈接的截圖，而不僅僅是裸鏈接。 – brettdj 2012-08-16 23:29:54

Sorceri，這個鏈接最底部的代碼是我需要的精確答案。它將過濾器複製到一個數組中 – phan 2012-08-17 01:21:36

性能明智的做法是將整組數據放入一個數組，然後根據該數組構建所需的數組，而不是將其移出到Excel電子表格中，然後將其讀回到數組中然後從電子表格中清除數據？ – MorkPork 2015-01-12 21:03:42

以下從列A中獲取信息並給出一個列表。它假定你有一個可用於數據輸入的「Sheet3」（你可能希望改變它）。

Sub test() 

    Dim targetRng As Range 
    Dim i As Integer 

    Set targetRng = Sheets(3).Range("a1") 
    Range("A1", Range("A999").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=targetRng, Unique:=True 

    Dim numbElements As Integer 
    numbElements = targetRng.End(xlDown).Row 
    Dim arr() As String 

    ReDim arr(1 To numbElements) As String 

    For i = 1 To numbElements 
     arr(i) = targetRng.Offset(i - 1, 0).Value 
    Next i 

End Sub

來源

2012-08-16 21:58:31 enderland

Sub tester() 

    Dim arr 
    arr = UniquesFromRange(ActiveSheet.Range("A1:A5")) 
    If UBound(arr) = -1 Then 
     Debug.Print "no values found" 
    Else 
     Debug.Print "got array of unique values" 
    End If 

End Sub 


Function UniquesFromRange(rng As Range) 
    Dim d As Object, c As Range, tmp 
    Set d = CreateObject("scripting.dictionary") 
    For Each c In rng.Cells 
     tmp = Trim(c.Value) 
     If Len(tmp) > 0 Then 
      If Not d.Exists(tmp) Then d.Add tmp, 1 
     End If 
    Next c 
    UniquesFromRange = d.keys 
End Function

來源

2012-08-16 22:15:46

已整整一年，因爲這個問題被問，但我今天遇到了同樣的問題，這是我爲它的解決方案：

Function copyFilteredData() As Variant 
    Dim selectedData() As Variant 
    Dim aCnt As Long 
    Dim rCnt As Long 

    Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select 
    On Error GoTo MakeArray: 
    For aCnt = 1 To Selection.Areas.Count 
     For rCnt = 1 To Selection.Areas(aCnt).Rows.Count 
      ReDim Preserve SelectedData(UBound(selectedData) + 1) 
      selectedData(UBound(selectedData)) = Selection.Areas(aCnt).Rows(rCnt) 
     Next 
    Next 

    copyFilteredData = selectedData 
    Exit Function 

MakeArray: 
    ReDim selectedData(1) 
    Resume Next 

End Function

這將使數組的元素0爲空，但UBound（SelectedData）返回選擇中的行數

來源

2013-08-16 09:42:26

Redim是一個非常昂貴的行動。我不會在這樣的循環中使用它，除非預期的迭代次數非常低。 – 2016-08-11 18:41:36

@MorSagmon你能解釋一下redim代價高昂嗎？ – 2016-08-12 05:49:41

你也應該[避免使用select]（https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros）並聲明一些範圍來代替'Selection'。除此之外，很好的方法 – Wolfie 2017-08-30 08:28:44

只是爲了防止任何人再次看到這個... 我創建了這個函數來處理一維範圍，但它也會寫一個較高的維度範圍到一維陣列;修改爲將多維範圍寫入「相同形狀」的陣列應該不會太難。您需要具有對scrrun.dll的引用來創建字典對象。縮放可能是一個問題，因爲「每一個」循環使用，但如果你使用EXCEL這很可能是什麼你是擔心：

Function RangeToArrUnique(rng As Range) 
    Dim d As Object, cl As Range 
    Set d = CreateObject("Scripting.Dictionary") 
    For Each cl In rng 
     d(cl.Value) = 1 
    Next cl 
    RangeToArrUnique = d.keys 
End Function

我用這種方式測試了這個：

Dim dat as worksheet 
set dat = sheets("Data") 
roomArr = Array("OR01","OR02","OR03") 
dat.UsedRange.AutoFilter field:=2, criteria1:=roomArr, operator:=xlFilterValues 
fltArr = RangeToArrUnique(dat.UsedRange.SpecialCells(CellTypeVisible))

希望這可以幫助那裏的人！

來源

2016-01-20 15:26:20 mmurrietta

如何將過濾的範圍複製到數組中？ （EXCEL VBA）

回答

相關問題

如何將過濾的範圍複製到數組中？（EXCEL VBA）