VBA抓取相同条件不重复数据

发布网友发布时间：2023-02-08 05:06

共1个回答

热心网友时间：2024-12-13 09:16

Sub 汇总()
b1 = "sheet1"    '''''''''''改为表1的名字
b2 = "sheet2"   '''''''''''改为表2的名字
    n = Sheets(b2).[a65536].End(xlUp).Row - 1
    arr = Sheets(b2).[a2].Resize(Sheets(b2).[a65536].End(xlUp).Row - 1, 2)
    h = 1
    For i = 2 To Sheets(b1).[a65536].End(xlUp).Row
    ReDim arr1(1 To n)
        For x = 1 To UBound(arr)
            If Sheets(b1).Cells(i, 1) = arr(x, 1) Then
                arr1(h) = arr(x, 2)
                h = h + 1
            End If
        Next x
        For k = 1 To UBound(arr1)
        For k1 = k + 1 To UBound(arr1)
            If arr1(k) = arr1(k1) Then
                arr1(k1) = ""
            End If
        Next k1, k

        krr = Join(arr1)
        krr = Application.Trim(krr)
        brr = Split(krr)
        krr = Join(brr, ",")
        Sheets(b1).Cells(i, 2) = krr
    Next i
End Sub