能否把筛选出来的结果直接赋值给数组。

mfk1288

Sub Filter()

Sheet1.Range("A1").CurrentRegion.AdvancedFilter _

Action:=xlFilterCopy, Unique:=True, _

CopyToRange:=Sheet2.Range("A1")

End Sub

这是把sheet1表的A列筛选出不重复数据到sheet2表的A列中，现在请教能否直接到筛选出的结果直接赋值给数组arr.

roserice

arr=range("a1:a"&counta(a:a))

mfk1288

roserice 发表于 2022-7-19 09:50
arr=range("a1:a"&counta(a:a))

这是直接把未给处理的数据赋值给arr.现在是要把处理后的数据赋值给arr.并且是想把处理后直接赋值给数组，而不是先在shee2得出结果再赋值、

roserice

mfk1288 发表于 2022-7-19 10:16
这是直接把未给处理的数据赋值给arr.现在是要把处理后的数据赋值给arr.并且是想把处理后直接赋值给数组， ...

eennoo

1. Sub Filter()
   
2. Dim i, r, arr()
   
3. Sheet1.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
   
4. i = 1
   
5. For Each r In Sheet1.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
   
6. ReDim Preserve arr(1 To i)
   
7. arr(i) = r
   
8. i = i + 1
   
9. Next
   
10. End Sub
    

复制代码

0101q

roserice 发表于 2022-7-19 09:50
arr=range("a1:a"&counta(a:a))

Private Sub UserForm_Initialize()
    On Error Resume Next
    Dim Col As New Collection
    Dim rng As Range, arr
    Dim i As Integer
    For Each rng In Range("A1:A" & [a65536].End(xlUp).Row)
        If Trim(rng) <> "" Then
            Col.Add rng, key:=CStr(rng)
        End If
    Next
    ReDim arr(1 To Col.Count)
    For i = 1 To Col.Count
        arr(i) = Col(i)
    Next
    Me.ListBox1.List = arr
End Sub

qdtzq

利用高级筛选生成一个新的区域再赋值给数组，再删除临时区域

okjok

1. arr=range("a:a").specialcells(xlcelltypevisible)

复制代码

okjok

1. Sub Filter()
   
2. Sheet1.Range("A1").CurrentRegion.AdvancedFilter _
   
3. Action:=xlFilterCopy, Unique:=True, _
   
4. arr=range("a:a").specialcells(xlcelltypevisible)
   
5. End Sub

复制代码