如何将过滤的范围复制到数组中？（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 21:45:20

好的。有没有办法只使用代码而不是隐藏工作表上的单元格完成相同的结果？也就是说，结果是在范围A1：A100中找到所有唯一记录（避免重复值）并将其放入数组中。 – phan 2012-08-16 21:50:21

答

你会想Read this，它会指向您在正确的方向

它说：

使用AdvancedFilter方法在工作表中的一些未使用的空间，创造了过滤范围
将该范围的Value属性赋值给Variant以创建一个二维数组
使用ClearContents方法的t帽子范围内摆脱它

请发布步骤或至少是此链接的截图，而不仅仅是裸链接。 – 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

答

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

答

已整整一年，因为这个问题被问，但我今天遇到了同样的问题，这是我为它的解决方案：

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）返回选择中的行数

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))

希望这可以帮助那里的人！

如何将过滤的范围复制到数组中？ （EXCEL VBA）

相关推荐

如何将过滤的范围复制到数组中？（EXCEL VBA）