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

mekemeke

小女子在这里求教了，麻烦各位大神能帮一帮啦~~实在是为了这个表格头大哇哇~~~有两张表格，如下图这样的：



要把第一个表格里面的数据转换成第二个表格这样的
第一个表格里面，第二列为托盘数量，如果有一行就代表有一个托盘，有三行就代表有三个托盘，最大可能有20行；里面的数据代表长宽高；@后面的数字代表有几件货物
第二个表格里面，第二三四列代表高宽长

结合实际发觉昨天表达的有错误，谁让偶笨呢。。。
万分感谢呢~~谢谢各位大神呢~~

mmlzh

这个公式做不出来了，去VBA版块试试吧。

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.   ReDim brr(1 To 1000, 1 To 4)
    
11.   m = 0
    
12.   With Worksheets("sheet1")
    
13.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
    
14.     For i = 1 To r
    
15.       If .Cells(i, 1).MergeArea.Cells(1, 1).Address = .Cells(i, 1).Address Then
    
16.         hs = .Cells(i, 1).MergeArea.Rows.Count
    
17.         m = m + 1
    
18.         brr(m, 1) = .Cells(i, 1)
    
19.         n = 0
    
20.         For j = i To i + hs - 1
    
21.           Set mh = reg.Execute(.Cells(j, 2).Value)
    
22.           If mh.Count = 4 Then
    
23.             For k = 1 To Val(mh(3))
    
24.               n = n + 1
    
25.               brr(m, 2) = brr(m, 2) & "," & "H" & n & ":" & mh(2)
    
26.               brr(m, 3) = brr(m, 3) & "," & "W" & n & ":" & mh(1)
    
27.               brr(m, 4) = brr(m, 4) & "," & "L" & n & ":" & mh(0)
    
28.             Next
    
29.           End If
    
30.         Next
    
31.       End If
    
32.     Next
    
33.     For i = 1 To m
    
34.       For j = 2 To 4
    
35.         brr(i, j) = Mid(brr(i, j), 2)
    
36.       Next
    
37.     Next
    
38.   End With
    
39.   With Worksheets("sheet3")
    
40.     .Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
41.   End With
    
42. End Sub
    

复制代码

chxw68

详见附件。

paciguard

做好了，见附件。。。

paciguard

1. Sub 按钮1_Click()
   
2. Dim ar, cc&
   
3. ReDim ar(1 To 4, 1 To 1)
   
4. cc = 1
   
5. For i = 1 To 4
   
6. Dim rng As Range, stra$, strb$, strc$, c&
   
7. stra = ""
   
8. strb = ""
   
9. strc = ""
   
10. Set rng = Range("A" & i).MergeArea
    
11. ReDim Preserve ar(1 To 4, 1 To cc)
    
12. ar(1, cc) = Range("A" & i).Text
    
13. k = 1
    
14. c = 0
    
15. For j = i To i + rng.Count - 1
    
16.    Do While k <= c + Val(Split(Split(Range("B" & j).Text, "@")(1), "(")(0))
    
17. If stra = "" Then
    
18. stra = "H" & k & ":" & Split(Split(Range("B" & j).Text, "@")(0), "×")(2)
    
19. strb = "W" & k & ":" & Split(Split(Range("B" & j).Text, "@")(0), "×")(1)
    
20. strc = "L" & k & ":" & Split(Split(Range("B" & j).Text, "@")(0), "×")(0)
    
21. Else
    
22. stra = stra & "," & "H" & k & ":" & Split(Split(Range("B" & j).Text, "@")(0), "×")(2)
    
23. strb = strb & "," & "W" & k & ":" & Split(Split(Range("B" & j).Text, "@")(0), "×")(1)
    
24. strc = strc & "," & "L" & k & ":" & Split(Split(Range("B" & j).Text, "@")(0), "×")(0)
    
25. End If
    
26.    k = k + 1
    
27.    Loop
    
28.    c = k - 1
    
29. Next j
    
30. ar(2, cc) = stra
    
31. ar(3, cc) = strb
    
32. ar(4, cc) = strc
    
33. i = i + rng.Count - 1
    
34. cc = cc + 1
    
35. Next i
    
36. Sheet1.Range("A" & 9).Resize(UBound(ar, 2), UBound(ar)) = Application.Transpose(ar)
    
37. End Sub
    

复制代码

mekemeke

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

太厉害了，请收下我的膜拜！ONZ

mekemeke

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

大神哥，有个地方我弄错了，就是第一个表格里面的第二列，不是三行，是这三个数据都在一个单元格里面的，能帮我修改一下吗？谢谢谢谢！

mekemeke

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

大神哥，有个地方我弄错了，就是第一个表格里面的第二列，不是三行，是这三个数据都在一个单元格里面的，能帮我修改一下吗？谢谢谢谢！

paciguard

mekemeke 发表于 2017-12-7 14:48
大神哥，有个地方我弄错了，就是第一个表格里面的第二列，不是三行，是这三个数据都在一个单元格里面的， ...

没问题，用split分割换行符。。。。。