|
你测试下这个代码看看,不知道是不是你的要求:
Application.ScreenUpdating = False
Dim arr
Dim arr1(1 To 2)
Dim arr2
arr = Worksheets("发货数据").Range("a2:n" & Worksheets("发货数据").Cells(Rows.Count, 1).End(3).Row)
Dim zd
Set zd = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
If Not zd.exists(arr(i, 6)) Then
arr1(1) = arr(i, 11)
arr1(2) = 1
zd(arr(i, 6)) = arr1
Else
arr2 = zd(arr(i, 6))
If InStr(arr2(1), arr(i, 11)) = 0 Then
arr2(1) = arr2(1) & "/" & arr(i, 11)
arr2(2) = arr2(2) + 1
zd(arr(i, 6)) = arr2
End If
End If
Next i
For i = 2 To Cells(Rows.Count, 2).End(3).Row
s = Cells(i, 2)
If zd.exists(s) Then
Cells(i, 3) = zd(s)(2)
Else
Cells(i, 3) = ""
End If
Next i
Application.ScreenUpdating = True
按照这个代码,最后只有这么几个是大于1的,我有点信心不足:
668737657000432 | 2 | 668737849555314 | 2 | 668737849555326 | 2 | 668737849334292 | 2 | 668737849334309 | 2 | 668737849334315 | 2 | 668737850130766 | 2 | 668737849334322 | 2 | 668737849334334 | 2 | 668737849580796 | 2 | 202005220001 | 39 |
|
|