从列到行复制唯一值

how can i copy unique values from a column in one Excel sheet to a row in another excel sheet using vba code?

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

i have a list of values at sheet1 column B which contains duplictes, and i want to copy it to sheet 2 row 1 without duplicates, i have tried:

我有一个值列表在sheet1列B,其中包含重复项,我想将它复制到第2页第1行没有重复,我尝试过:

Public Sub Test()

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

End Sub

but it does not work and also does not use the fact that not all of the column contains values.

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

how can i do that?

我怎样才能做到这一点?

2 个解决方案

#1

Try MAIN

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

#2

Sub getUnique()

Dim oWs As Worksheet: Set oWs = ActiveSheet Dim oRg As Range: Set oRg = oWs.Range("B2:B65536") Dim oRg_tmp As Range

Dim oWs As Worksheet:设置oWs = ActiveSheet Dim oRg As Range:设置oRg = oWs.Range(“B2:B65536”)Dim oRg_tmp As Range

oRg.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

oRg.AdvancedFilter动作:= xlFilterInPlace,唯一:=真

For Each oRg_tmp In oRg.Rows.SpecialCells(xlCellTypeVisible).Rows MsgBox "Heres a row, now grab what you want: " & oRg_tmp.row Next

For each oRg_tmp in oRg.Rows.SpecialCells(xlCellTypeVisible).Rows MsgBox“Heres a row,now grab your what what:”&oRg_tmp.row Next

End Sub

#1