重新排列的问题，感谢各位高手！

tzexcelhome

重新排列的问题，感谢各位高手！

shiruiqiang

bc做字典，嵌套a列字典

fzxba

求助.zip (24.01 KB, 下载次数: 10)

2024-3-14 20:47 上传

点击文件名下载附件

tzexcelhome

fzxba 发表于 2024-3-14 20:48

感谢fzxba老师的帮助和指导，万分感谢！

tzexcelhome

shiruiqiang 发表于 2024-3-14 20:44
bc做字典，嵌套a列字典

谢谢您的参与，感谢！

ykcbf1100

附件供参考。。。

ykcbf1100

字典+数组

1. Sub ykcbf()   '//2024.3.14
   
2.     Dim arr, d
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set d1 = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("原始")
   
7.         r = .Cells(.Rows.Count, "a").End(xlUp).Row
   
8.         arr = .[a1].Resize(r, 4)
   
9.     End With
   
10.     For i = 2 To UBound(arr)
    
11.         s = arr(i, 1)
    
12.         d1(s) = ""
    
13.         s = arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 1)
    
14.         d(s) = arr(i, 4)
    
15.     Next
    
16.     t = d.items
    
17.     ReDim brr(1 To d.Count, 1 To 2)
    
18.     For Each k In d.keys
    
19.         If k <> Empty Then
    
20.             m = m + 1
    
21.             brr(m, 1) = Split(k, "|")(0)
    
22.             brr(m, 2) = Split(k, "|")(1)
    
23.         End If
    
24.     Next
    
25.     With Sheets("目的")
    
26.         .UsedRange.Offset(1, 2).ClearContents
    
27.         .[c1].Resize(1, d1.Count) = d1.keys
    
28.         .[a2].Resize(m, 2) = brr
    
29.         arr = .[a1].Resize(m + 1, 2 + d1.Count)
    
30.         For i = 2 To UBound(arr)
    
31.             For j = 3 To UBound(arr, 2)
    
32.                 s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(1, j)
    
33.                 If d.Exists(s) Then
    
34.                     arr(i, j) = d(s)
    
35.                 End If
    
36.             Next
    
37.         Next
    
38.         .[a1].Resize(m + 1, 2 + d1.Count) = arr
    
39.     End With
    
40.     Set d = Nothing
    
41.     Application.ScreenUpdating = True
    
42.     MsgBox "OK！"
    
43. End Sub
    
44. 
    

复制代码

tzexcelhome

ykcbf1100 发表于 2024-3-14 21:20
字典+数组

感谢老是的指点！！！

tzexcelhome

ykcbf1100 发表于 2024-3-14 21:20
字典+数组

老师，这个代码没有问题，运行很好。现在碰到一个新问题：就是成品编码超过18位数，而且是以文本保存，如果用vba的话，他自动转为为数值格式。请老师看看这样可不可以解决？感谢！

ykcbf1100

tzexcelhome 发表于 2024-3-19 21:48
老师，这个代码没有问题，运行很好。现在碰到一个新问题：就是成品编码超过18位数，而且是以文本保存，如 ...

附件中没有编码啊