大神求助，怎么查找重复项并合并在一起

xuyu135579

大致需求是：根据I列门店编码判断，是否有重复编码，若重复则保留第一行，并将AD列合并在一起，其他不变，并删除重复行。。没学过VBA，网上找个几份代码改过，都合并不了 不知道哪里的问题。。求教大师，谢谢！

xuyu135579

Sub test()
    Application.ScreenUpdating = False
    Dim arr, brr(1 To 47), i&, j%, r&, n%, temp
    Set d = CreateObject("scripting.dictionary")
    With Sheets("报表")
        r = .Cells.Find("*", Cells(1, 2), xlValues, xlWhole, xlByRows, xlPrevious).Row
        arr = .Range("B3:AV" & r)
        For i = 1 To UBound(arr)
            If Not d.exists(arr(i, 8)) Then
                brr(1) = arr(i, 1)
                For j = 3 To UBound(arr, 2)
                    brr(j - 1) = arr(i, j - 1)
                Next j
                d(arr(i, 1)) = brr
            Else
                temp = d(arr(i, 1))
                temp(29) = temp(29) + arr(i, 29)
               
                d(arr(i, 1)) = temp
            End If
        Next i
    End With
    With Sheets("报表2")
        .[a4:AV65536] = ""
        .[b4].Resize(d.Count, 47) = arr
    End With
    Application.ScreenUpdating = True
End Sub

找不到问题。。

yylucke

AD列合并在一起
什么意思？

xuyu135579

yylucke 发表于 2018-6-21 15:17
AD列合并在一起
什么意思？

就比如第一行的I列跟第二行的I列是相同的，那么就把第二行的AD单元格里面的URL合并到第一行的AD单元格里面然后删除第二行

yylucke

xuyu135579 发表于 2018-6-21 15:33
就比如第一行的I列跟第二行的I列是相同的，那么就把第二行的AD单元格里面的URL合并到第一行的AD单元格里 ...

兄弟，你的AD列都有数据，为嘛要合并呢。
简单的说，你的要求不就是删除重复行吗？

xuyu135579

yylucke 发表于 2018-6-21 15:42
兄弟，你的AD列都有数据，为嘛要合并呢。
简单的说，你的要求不就是删除重复行吗？

是删除重复项 但是我这边很多行数据，AD都是不同的URL链接 就需要合并。。。简单来说就是删除重复项的同时把AD列合并

yylucke

xuyu135579 发表于 2018-6-21 16:03
是删除重复项 但是我这边很多行数据，AD都是不同的URL链接 就需要合并。。。简单来说就是删除重复项的同 ...

还是不清楚合并，
是把所有重复项的AD单元格值合并到第一个，还是只保留重复项的最后一个数据对应AD的值？

xuyu135579

yylucke 发表于 2018-6-21 16:39
还是不清楚合并，
是把所有重复项的AD单元格值合并到第一个，还是只保留重复项的最后一个数据对应AD的值 ...

把所有重复项的AD单元格值合并到第一个

yylucke

Private Sub CommandButton1_Click()
Dim LastRow, MyArr
Application.ScreenUpdating = False
With Sheet1
    LastRow = .Cells(.Cells.Rows.Count, 9).End(xlUp).Row
    MyArr = .Range("A1:AV" & LastRow)
    For i = LastRow To 5 Step -1
        Tmp重复 = Application.Match(MyArr(i, 9), .Range("I1:I" & i - 1), 0)
        If Not IsError(Tmp重复) Then
            .Cells(Tmp重复, 30) = .Cells(Tmp重复, 30) & Chr(10) & MyArr(i, 30)
            .Rows(i).Delete
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub

yylucke

请参考附件