求大神用代码将下列数据进行转换一下

15899681383

求大神用代码将下列数据进行转换一下。
将 转化为下面格式




附件已附上，谢谢！

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("交期表")
   
5.     r = .Cells(.Rows.Count, 13).End(xlUp).Row
   
6.     arr = .Range("m2:n" & r)
   
7.     ReDim brr(1 To UBound(arr), 1 To 7)
   
8.     For i = 1 To UBound(arr)
   
9.       brr(i, 1) = arr(i, 1)
   
10.       xm = Split(arr(i, 2), "  ")
    
11.       n = 2
    
12.       For j = 0 To UBound(xm) Step 2
    
13.         brr(i, n) = Split(xm(j), ":")(1)
    
14.         brr(i, n + 1) = Val(xm(j + 1))
    
15.         n = n + 2
    
16.       Next
    
17.     Next
    
18.     .Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
19.   End With
    
20. End Sub
    

复制代码

chxw68

详见附件。

15899681383

chxw68 发表于 2020-10-30 19:18
详见附件。

CH大哥，还有个问题，如果中间空格数不确定，能否有方法实现？

chxw68

15899681383 发表于 2020-10-30 19:25
CH大哥，还有个问题，如果中间空格数不确定，能否有方法实现？

可以，需要使用正则表达式。

15899681383

chxw68 发表于 2020-10-30 19:56
可以，需要使用正则表达式。

能否帮忙写一下呢？

chxw68

修改好了。

liulang0808

Sub test()
  Set reg = CreateObject("vbscript.regexp")
  reg.Global = True
  reg.Pattern = "[^\s]+"
  With Worksheets("交期表")
    r = .Cells(.Rows.Count, 13).End(xlUp).Row
    arr = .Range("m2:n" & r)
    ReDim brr(1 To UBound(arr), 1 To 7)
    For i = 1 To UBound(arr)
      brr(i, 1) = arr(i, 1)
      Set xm = reg.Execute(arr(i, 2))
      n = 2
      For j = 0 To xm.Count - 1 Step 2
        brr(i, n) = Split(xm(j), ":")(1)
        brr(i, n + 1) = Val(xm(j + 1))
        n = n + 2
      Next
    Next
    .Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
  End With
End Sub

借用了二楼褚老师的代码

准提部林

Sub TST_A1()
Dim Arr, A, Brr, TR, i&, C%, Cx%
Arr = Range([N1], [M65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 200)
Brr(1, 1) = "ItemNo"
For i = 2 To UBound(Arr)
    C = 2: Brr(i, 1) = Arr(i, 1)
    For Each A In Split(Arr(i, 2), "ETA:")
        If A = "" Then GoTo a01
        TR = Split(Trim(A), " ")
        Brr(i, C) = TR(0)
        Brr(i, C + 1) = Val(TR(UBound(TR)))
        If C > Cx Then Cx = C: Brr(1, C) = "ETA" & C / 2: Brr(1, C + 1) = "QTY"
        C = C + 2
a01: Next A
Next i
[A2].Resize(UBound(Arr), Cx + 1) = Brr
End Sub

15899681383

chxw68 发表于 2020-10-30 20:03
修改好了。

非常感谢！