将唯一值从列复制到行

Question

如何使用VBA代码将唯一值从一个Excel工作表中的列复制到另一个Excel工作表中的行？

我在工作表1的列B包含重复项的列中有一个值列表，并且我想将其复制到工作表2的第1行而不重复，我已经尝试过：

Public Sub Test()

ActiveSheet.Range("B2:B65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(2).Range("D1"), Unique:=True

End Sub

但它不起作用，也没有使用并非所有列都包含值的事实。

我怎样才能做到这一点？

Answer 1

尝试主

Sub MAIN()
    Dim N As Long
    Dim cl As Collection
    N = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
    Set cl = MakeColl(ActiveSheet.Range("B1:B" & N))
    Call FillRange(Sheets(2).Range("D1:IV1"), cl)
End Sub

Public Function MakeColl(rng As Range) As Collection
    Set MakeColl = New Collection
    Dim r As Range
    On Error Resume Next
    For Each r In rng
        v = r.Value
        If v <> "" Then
            MakeColl.Add v, CStr(v)
        End If
    Next r
End Function

Sub FillRange(rng As Range, col As Collection)
    Dim I As Long, r As Range, J As Long
    I = 1
    J = col.Count
    For Each r In rng
        MsgBox r.Parent.Name & r.Address(0, 0)
        r.Value = col.Item(I)
        If I = J Then Exit Sub
        I = I + 1
    Next r
End Sub

Answer 2

子getUnique（）

昏暗oWs作为工作表：设置oWs = ActiveSheet昏暗oRg作为范围：设置oRg = oWs.Range（“ B2：B65536”）昏暗oRg_tmp作为范围

oRg.AdvancedFilter操作：= xlFilterInPlace，唯一：= True

对于oRg.Rows.SpecialCells（xlCellTypeVisible）.Rows MsgBox中的每个oRg_tmp“在这里一行，现在抓取您想要的内容：”＆oRg_tmp.row

结束子