由于客户需要，将二维码扫描信息解析出相对应的数据

yuanzhao

各位老师：
              请帮帮忙，怎么样把数据，区分开来。

Chip_Kenny

1. Sub zz()
   
2. Dim d As Object, ar, b(), s$, k, t, rp As Object
   
3. Set rp = CreateObject("vbscript.regexp")
   
4. Set d = CreateObject("scripting.dictionary")
   
5. rp.Pattern = "\d+"
   
6. ar = Sheets(2).[a236].CurrentRegion.Value
   
7. For i = 2 To UBound(ar)
   
8.     d(ar(i, 1)) = ar(i, 2)
   
9. Next
   
10. With Sheets(1)
    
11.     ar = .Range("b2:b" & .[b1048576].End(3).Row).Value
    
12.     ReDim b(1 To UBound(ar), 1 To 10)
    
13.     For i = 1 To UBound(ar)
    
14.         If Len(ar(i, 1)) > 0 Then
    
15.             s = Split(ar(i, 1), "|")(0)
    
16.             k = Split(s & Replace(ar(i, 1), "-", "|", Len(s) + 1), "|")
    
17.             For j = 0 To 2
    
18.                 b(i, j + 1) = k(j)
    
19.             Next
    
20.             b(i, j + 1) = rp.Replace(k(j), "")
    
21.             b(i, j + 2) = Replace(k(j), b(i, j + 1), "")
    
22.             For j = 4 To UBound(k)
    
23.                 b(i, j + 2) = k(j)
    
24.             Next
    
25.             b(i, j + 2) = d(b(i, 1))
    
26.             b(i, j + 3) = i
    
27.         End If
    
28.     Next
    
29. End With
    
30. [e2].Resize(i - 1).NumberFormat = 0
    
31. [d2].Resize(i - 1, 10) = b
    
32. End Sub

复制代码

yuanzhao

Chip_Kenny 发表于 2018-6-11 11:01

谢谢老师！不过好像没有达到我附件里面的要求，解析出来没有到相应的表格里面，不过也谢谢你！

Chip_Kenny

試過沒有問題，附件加個按鈕給你試下。

yuanzhao

Chip_Kenny 发表于 2018-6-11 11:57
試過沒有問題，附件加個按鈕給你試下。

哦！，我复制你帮忙写的代码，在宏模版里面的时候，被我不小心，弄掉一行，我说怎么弄不出来，有些有，有些没有，比对一下，我弄错了，真的非常感谢你的帮助。