各位大神帮助小女子解决这个问题吧，头大了

mekemeke

paciguard 发表于 2017-12-7 15:14
没问题，用split分割换行符。。。。。

能不能重新做个表格呀，vba偶实在弄不来。。。:=(

mekemeke

chxw68 发表于 2017-12-7 09:55
详见附件。

大神哥，偶昨天表达有误，能帮偶改改吗，谢谢呢

mekemeke

paciguard 发表于 2017-12-7 10:41

大神哥，偶昨天表达有误，能帮偶改改吗，谢谢呢

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim reg As New RegExp
   
5.   With reg
   
6.     .Global = True
   
7.     .Pattern = "[.\d]+"
   
8.     Set mh = .Execute(Range("b1"))
   
9.   End With
   
10.   With Worksheets("sheet1")
    
11.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
12.     arr = .Range("a1:c" & r)
    
13.     ReDim brr(1 To UBound(arr), 1 To 4)
    
14.     For i = 1 To UBound(arr)
    
15.       brr(i, 1) = arr(i, 1)
    
16.       crr = Split(arr(i, 2), vbLf)
    
17.       For j = 0 To UBound(crr)
    
18.         Set mh = reg.Execute(crr(j))
    
19.         If mh.Count = 4 Then
    
20.           For k = 1 To Val(mh(3))
    
21.             n = n + 1
    
22.             brr(i, 2) = brr(i, 2) & "," & "H" & n & ":" & mh(2)
    
23.             brr(i, 3) = brr(i, 3) & "," & "W" & n & ":" & mh(1)
    
24.             brr(i, 4) = brr(i, 4) & "," & "L" & n & ":" & mh(0)
    
25.           Next
    
26.         End If
    
27.       Next
    
28.     Next
    
29.     For i = 1 To UBound(brr)
    
30.       For j = 2 To 4
    
31.         brr(i, j) = Mid(brr(i, j), 2)
    
32.       Next
    
33.     Next
    
34.   End With
    
35.   With Worksheets("sheet3")
    
36.     .Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
37.   End With
    
38. End Sub
    

复制代码

chxw68

修改好了，单元格内数据以Alt+回车来换行。

mekemeke

大神哥，怎么送花啊？我发觉我没有送花功能

dypluck

chxw68 发表于 2017-12-8 09:10

Set mh = .Execute(Range("b1"))
大侠这一句没有什么用吧

chxw68

dypluck 发表于 2017-12-8 12:12
Set mh = .Execute(Range("b1"))
大侠这一句没有什么用吧

这一句是多余的，删掉吧。

mekemeke

chxw68 发表于 2017-12-8 09:10
修改好了，单元格内数据以Alt+回车来换行。

大神哥，发觉一个问题，就是vb出来的sheet2里面的数据，第二行开始是H6、H7。。。
应该还是H1、H2，这个是不是n = n+1删掉就可以啦？

mekemeke

chxw68 发表于 2017-12-8 09:10
修改好了，单元格内数据以Alt+回车来换行。

但是把n= n +1删掉，连序号数字都没了，哭。。。