数据表处理

kaijundu886

本人才疏学浅，纯属小白一个，请各位高手帮忙，看看能否用宏或者其他方法，把附件“数据表”里，物料编码一列里所有的数据，分别提取到“小件欠料”表中物料编码一列，按照相同的编码排列在一起，最好是放在对应物料编码汇总那一行的上一行。提示：数据表里的数据是会每天都在变化的，有可能会多很多行或者少很多行。

西瓜9527

不太明确你的需求

719404338

1. Sub t()
   
2. Dim i, j, d, arr
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. arr = Sheets("5-31").Range("b2:q" & Sheets("5-31").[b65536].End(3).Row)
   
5. For i = 2 To UBound(arr)
   
6. d(arr(i, 1)) = d(arr(i, 1)) & Join(Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8), arr(i, 9), arr(i, 10), arr(i, 11), arr(i, 12), arr(i, 1), arr(i, 13), arr(i, 14), arr(i, 15), arr(i, 16))) & "#"
   
7. Next
   
8. For Each sj In d
   
9. If Not Range("a:a").Find(sj) Is Nothing Then
   
10. i = Range("a:a").Find(sj).Row
    
11. For j = 0 To UBound(Split(d(sj), "#")) - 1
    
12. Rows(i).Insert Shift:=xlDown
    
13. Range("a" & i).Resize(1, 16) = Split(Split(d(sj), "#")(0), " ")
    
14. Next j
    
15. End If
    
16. Next
    
17. End Sub

复制代码

719404338

回复审核中，详见附件。

kaijundu886

719404338 发表于 2019-6-2 10:58

非常感谢帮忙，功能非常强大，但执行宏后发现，提取到小件欠货表后的同一个物料编码的数量有问题
详情见附件。
另外，要是能把代码解释一下就更好了

719404338

已修改，请测试。

1. Sub t()
   
2. Dim i, j, d, arr
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. arr = Sheets("5-31").Range("b2:q" & Sheets("5-31").[b65536].End(3).Row)
   
5. For i = 2 To UBound(arr)
   
6. d(arr(i, 1)) = d(arr(i, 1)) & Join(Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8), arr(i, 9), arr(i, 10), arr(i, 11), arr(i, 12), arr(i, 1), arr(i, 13), arr(i, 14), arr(i, 15), arr(i, 16))) & "#"
   
7. Next
   
8. Stop
   
9. For Each sj In d
   
10. If Not Range("a:a").Find(sj) Is Nothing Then
    
11. i = Range("a:a").Find(sj).Row
    
12. For j = 0 To UBound(Split(d(sj), "#")) - 1
    
13. Rows(i).Insert Shift:=xlDown
    
14. Range("a" & i).Resize(1, 16) = Split(Split(d(sj), "#")(j), " ")
    
15. Next j
    
16. End If
    
17. Next
    
18. End Sub

复制代码

kaijundu886

719404338 发表于 2019-6-2 22:28
已修改，请测试。

不行呀，运行到 stop就停住了
Sub Macro1()
Dim i, j, d, arr
Set d = CreateObject("Scripting.Dictionary")
arr = Sheets("5-31").Range("b2:q" & Sheets("5-31").[b65536].End(3).Row)
For i = 2 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) & Join(Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8), arr(i, 9), arr(i, 10), arr(i, 11), arr(i, 12), arr(i, 1), arr(i, 13), arr(i, 14), arr(i, 15), arr(i, 16))) & "#"
Next
Stop
For Each sj In d
If Not Range("a:a").Find(sj) Is Nothing Then
i = Range("a:a").Find(sj).Row
For j = 0 To UBound(Split(d(sj), "#")) - 1
Rows(i).Insert Shift:=xlDown
Range("a" & i).Resize(1, 16) = Split(Split(d(sj), "#")(j), " ")
Next j
End If
Next
End Sub

kaijundu886

719404338 发表于 2019-6-2 22:28
已修改，请测试。

我删掉stop就可以了，但还是有些格式对不到，5-31表里有131条数据，但提取到小件欠货里只有70条数据
如果5-31表里的物料编码，在小件欠货表里查找不到的话，需要那些数据全部放到小件欠货表里的最后边

kaijundu886

还有哪位大神可以帮帮忙呀，将不胜感激。

lsc900707

kaijundu886 发表于 2019-6-4 00:07
我删掉stop就可以了，但还是有些格式对不到，5-31表里有131条数据，但提取到小件欠货里只有70条数据
如 ...

1. Sub Macro1()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = Sheets("5-31").Range("b2:q" & Sheets("5-31").[b65536].End(3).Row)
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 1)) = d(arr(i, 1)) & Join(Array(arr(i, 1), arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6), arr(i, 7), arr(i, 8), arr(i, 9), arr(i, 10), arr(i, 11), arr(i, 12), arr(i, 1), arr(i, 13), arr(i, 14), arr(i, 15), arr(i, 16))) & "#"
   
6.     Next
   
7.     For Each sj In d
   
8.         If Not Range("a:a").Find(sj) Is Nothing Then
   
9.             i = Range("a:a").Find(sj).Row
   
10.             For j = 0 To UBound(Split(d(sj), "#")) - 1
    
11.                 Rows(i).Insert Shift:=xlDown
    
12.                 Range("a" & i).Resize(1, 16) = Split(Split(d(sj), "#")(j), " ")
    
13.             Next
    
14.         Else
    
15.             r = Cells(Rows.Count, 1).End(3).Row + 1
    
16.             For j = 0 To UBound(Split(d(sj), "#")) - 1
    
17.                 Cells(r, 1).Resize(1, 16) = Split(Split(d(sj), "#")(j), " ")
    
18.             Next
    
19.         End If
    
20.     Next
    
21. End Sub

复制代码

修改原代码试试：