[已解决]如何根据符号分行

那么的帅

chen2102055 发表于 2014-4-2 23:00
文件传了，请帮帮忙，初始值，想要达到的效果都在里面了，希望通过VBA的方式实现，谢谢了！

B C 列数据是否是手工输入的，B C列的逗号和A列的逗号不一样，是实际这样的情况，还是手工输入的错误？
最好提供最原始的数据

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, n&, j%, s2&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. ReDim brr(1 To 20000, 1 To UBound(arr, 2))
   
6. With CreateObject("vbscript.regexp")
   
7.     .Pattern = "\[.*\]"
   
8.     .Global = True
   
9.     For i = 1 To UBound(arr)
   
10.         For Each m In .Execute(arr(i, 1))
    
11.             s = s + 1
    
12.             d(s) = m
    
13.         Next
    
14.         x = Split(.Replace(arr(i, 1), "~"), ",")
    
15.         y = Split(arr(i, 2), ",")
    
16.         z = Split(arr(i, 3), ",")
    
17.         For j = 0 To UBound(x)
    
18.             n = n + 1
    
19.             brr(n, 2) = y(j)
    
20.             brr(n, 3) = z(j)
    
21.             If InStr(x(j), "~") Then
    
22.                 s2 = s2 + 1
    
23.                 brr(n, 1) = Replace(x(j), "~", d(s2))
    
24.             Else
    
25.                 brr(n, 1) = x(j)
    
26.             End If
    
27.         Next
    
28.     Next
    
29. End With
    
30. Sheet2.Activate
    
31. Range("a1").Resize(n, 3) = brr
    
32. End Sub
    

复制代码

dsmch

代码考虑了一个数据中有多个中括号情况，请测试

chen2102055

那么的帅 发表于 2014-4-3 00:05
B C 列数据是否是手工输入的，B C列的逗号和A列的逗号不一样，是实际这样的情况，还是手工输入的错误？
...

输入错误，都是英文的逗号，原始数据基本就这样，因为太多了，我就截取了一部分

chen2102055

dsmch 发表于 2014-4-3 13:23
代码考虑了一个数据中有多个中括号情况，请测试

谢谢啊，但是为什么我运行显示找不到工程或库呢，我再研究一下

dsmch

给你一个win7版本，你测试一下，我已测试正常

chen2102055

dsmch 发表于 2014-4-3 21:42
给你一个win7版本，你测试一下，我已测试正常

非常感谢，测试OK，如果方便的话能不能把代码解释一下，我是菜鸟一枚，很多看不太懂

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, n&, j%, s2&
   
3. '创建字典对象
   
4. Set d = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. ReDim brr(1 To 20000, 1 To UBound(arr, 2))
   
7. '用正则表达式查找中括号
   
8. With CreateObject("vbscript.regexp")
   
9.     .Pattern = "\[.*\]" '中括号及内容
   
10.     .Global = True
    
11.     For i = 1 To UBound(arr)
    
12.         For Each m In .Execute(arr(i, 1))
    
13.         '第一个中括号对应1，第二个对应2……
    
14.             s = s + 1
    
15.             d(s) = m
    
16.         Next
    
17.         '中括号替换为~后按"，"分列
    
18.         x = Split(.Replace(arr(i, 1), "~"), ",")
    
19.         y = Split(arr(i, 2), ",") '第二列分列
    
20.         z = Split(arr(i, 3), ",") '第三列分列
    
21.         For j = 0 To UBound(x) '循环分列内容
    
22.             n = n + 1
    
23.             brr(n, 2) = y(j) '赋值到数组
    
24.             brr(n, 3) = z(j) '赋值到数组
    
25.             '如果分列后的内容包含~
    
26.             If InStr(x(j), "~") Then
    
27.                 s2 = s2 + 1
    
28.                 '根据字典对应值把~替换为实际内容
    
29.                 brr(n, 1) = Replace(x(j), "~", d(s2))
    
30.             Else
    
31.             '如不含~，直接赋值
    
32.                 brr(n, 1) = x(j)
    
33.             End If
    
34.         Next
    
35.     Next
    
36. End With
    
37. Sheet2.Activate
    
38. Range("a1").Resize(n, 3) = brr
    
39. End Sub
    

复制代码

chen2102055

dsmch 发表于 2014-4-3 22:22

好人啊！泪流满面！谢谢了！{:1112:}

tgydslr

神了啊