VBA一对多查找并合并

Lisianthus1

ykcbf1100 发表于 2024-6-25 15:45
上传附件看一下吧。

已上传附件 辛苦

ykcbf1100

Lisianthus1 发表于 2024-6-25 16:38
已上传附件 辛苦

你这个多店铺的话，代码得重写了。

ykcbf1100

Lisianthus1 发表于 2024-6-25 16:38
已上传附件 辛苦

改好了，多加个判断就可以了。

ykcbf1100

改好了。。。

1. Sub SKU拆解合并()
   
2.     Application.ScreenUpdating = False
   
3.     arr = Sheets("原始数据").UsedRange
   
4.     zrr = Sheets("关联数据").UsedRange
   
5.     Dim tm: tm = Timer
   
6.     ReDim brr(1 To 1000000, 1 To 100)
   
7.     For i = 2 To UBound(arr)
   
8.         For x = 2 To UBound(zrr)
   
9.             If zrr(x, 2) = arr(i, 4) Then
   
10.                 m = m + 1
    
11.                 For j = 1 To UBound(arr, 2)
    
12.                     brr(m, j) = arr(i, j)
    
13.                 Next
    
14.                 brr(m, 9) = zrr(x, 7)
    
15.                 brr(m, 10) = zrr(x, 8)
    
16.                 brr(m, 11) = arr(i, 5) * zrr(x, 8)
    
17.             End If
    
18.         Next
    
19.     Next
    
20.     With Sheets("合并数据")
    
21.         .UsedRange.Offset(1) = ""
    
22.         With .[a2].Resize(m, 11)
    
23.             .Value = brr
    
24.             .Borders.LineStyle = 1
    
25.             .HorizontalAlignment = xlCenter
    
26.             .VerticalAlignment = xlCenter
    
27.         End With
    
28.     End With
    
29.     Application.ScreenUpdating = True
    
30.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
31. End Sub
    
32. 
    

复制代码

Lisianthus1

ykcbf1100 发表于 2024-6-25 16:51
改好了，多加个判断就可以了。

谢谢  又学到了！

Lisianthus1

ykcbf1100 发表于 2024-6-25 16:51
改好了，多加个判断就可以了。

老师 如果查找条件再加一个店铺 代码需要怎么修改呢？

ykcbf1100

Lisianthus1 发表于 2024-6-26 11:40
老师 如果查找条件再加一个店铺 代码需要怎么修改呢？

上附件吧，说明需求。

Lisianthus1

ykcbf1100 发表于 2024-6-26 11:41
上附件吧，说明需求。

就是用“关联数据“查找”采购SKU时” 条件用“店铺”+“店铺SKU”

ykcbf1100

Lisianthus1 发表于 2024-6-26 12:08
就是用“关联数据“查找”采购SKU时” 条件用“店铺”+“店铺SKU”

二个条件合并

ykcbf1100

二个条件合并

1. Sub SKU拆解合并()
   
2.     Application.ScreenUpdating = False
   
3.     arr = Sheets("原始数据").UsedRange
   
4.     zrr = Sheets("关联数据").UsedRange
   
5.     Dim tm: tm = Timer
   
6.     ReDim brr(1 To 1000000, 1 To 100)
   
7.     For i = 2 To UBound(arr)
   
8.         st = arr(i, 1) & arr(i, 4)
   
9.         For x = 2 To UBound(zrr)
   
10.             If zrr(x, 1) & zrr(x, 2) = st Then
    
11.                 m = m + 1
    
12.                 For j = 1 To UBound(arr, 2)
    
13.                     brr(m, j) = arr(i, j)
    
14.                 Next
    
15.                 brr(m, 9) = zrr(x, 7)
    
16.                 brr(m, 10) = zrr(x, 8)
    
17.                 brr(m, 11) = arr(i, 5) * zrr(x, 8)
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     With Sheets("合并数据")
    
22.         .UsedRange.Offset(1).Clear
    
23.         With .[a2].Resize(m, 11)
    
24.             .Value = brr
    
25.             .Borders.LineStyle = 1
    
26.             .HorizontalAlignment = xlCenter
    
27.             .VerticalAlignment = xlCenter
    
28.         End With
    
29.     End With
    
30.     Application.ScreenUpdating = True
    
31.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
32. End Sub
    

复制代码