求助大神帮帮忙,数据分裂转换

豪情雲天

求助,下面 vba代怎么写

图1数据格式转换成图2格式,
非常感谢,新年快乐!

ykcbf1100

用正则，附件供参考。。。

ykcbf1100

代码已更新。。。

1. Sub ykcbf()   '//2024.2.15
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     Set reg = CreateObject("VBScript.RegExp")
   
4.     r = Me.Cells(Rows.Count, 1).End(3).Row
   
5.     arr = Me.Range("a1:b" & r)
   
6.     ReDim brr(1 To 1000, 1 To 20)
   
7.     With reg
   
8.         .Global = True
   
9.         .Pattern = "([a-zA-Z]\d+)|(\d+)|([\u4e00-\u9fa5]+)"
   
10.     End With
    
11.     n = 2
    
12.     For i = 2 To UBound(arr)
    
13.         st = arr(i, 1)
    
14.         Set mh = reg.Execute(st)
    
15.         s1 = mh(0).Value & "|" & mh(1).Value
    
16.         If Not d.exists(s1) Then
    
17.             m = m + 1
    
18.             d(s1) = m
    
19.             brr(m, 1) = mh(0).Value
    
20.             brr(m, 2) = mh(1).Value
    
21.         End If
    
22.         s2 = mh(2).Value
    
23.         If Not d.exists(s2) Then
    
24.             n = n + 1
    
25.             d(s2) = n
    
26.         End If
    
27.         r = d(s1): c = d(s2)
    
28.         brr(r, c) = arr(i, 2)
    
29.     Next
    
30.     With Sheets("Sheet2")
    
31.         .UsedRange.Offset(2).Clear
    
32.         .Columns(1).NumberFormatLocal = "@"
    
33.         .[a3].Resize(m, n) = brr
    
34.         .[a3].Resize(m, n).Borders.LineStyle = 1
    
35.     End With
    
36.     Set d = Nothing
    
37.     MsgBox "OK!"
    
38. End Sub
    

复制代码

x-xx-xx

1-2            

今铭昔

gwjkkkkk

正则+字典。。。

lizhipei78

如果A列都是这么规则的话，不用到正则也可以，非常简单

一维转二维.rar (18.87 KB, 下载次数: 15)

2024-2-14 22:32 上传

点击文件名下载附件

lizhipei78

非常简单的一维转二维

ykcbf1100

lizhipei78 发表于 2024-2-14 21:01
如果A列都是这么规则的话，不用到正则也可以，非常简单

还是要考虑一下通用性。实际使用上，A列不一定这么规则。
用正则是最合适的。

gwjkkkkk

ykcbf1100 发表于 2024-2-14 21:13
还是要考虑一下通用性。实际使用上，A列不一定这么规则。
用正则是最合适的。

草爷说得不错，应该考虑通用性，如果其中有天蓝色呢，这样就不行了、