从列到行复制唯一值-Java 学习之路

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

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

Public Sub Test()

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

End Sub

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

我怎样才能做到这一点？

2 回答

0

Sub getUnique（）

Dim oWs As Worksheet：设置oWs = ActiveSheet Dim oRg As Range：设置oRg = oWs.Range（“B2：B65536”）Dim oRg_tmp As Range

oRg.AdvancedFilter动作：= xlFilterInPlace，唯一：=真

For each oRg_tmp in oRg.Rows.SpecialCells（xlCellTypeVisible）.Rows MsgBox“Heres a row，now grab your what what：”＆oRg_tmp.row Next

结束子

回复于 2024-04-26T04:43:58+08:00

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

回复于 2024-04-26T04:43:58+08:00

从列到行复制唯一值

2 回答

相关问题