根据符号拆分为多行

crudeoil123

大神，excel按条件自动拆分为多行，请帮助，谢谢。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.2
   
2.     With Sheets("Sheet1")
   
3.         r = .Cells(Rows.Count, 1).End(3).Row
   
4.         c = .UsedRange.Columns.Count
   
5.         arr = .[a1].Resize(r, c)
   
6.     End With
   
7.     ReDim brr(1 To 10000, 1 To UBound(arr, 2))
   
8.     For i = 1 To UBound(arr)
   
9.         st = Split(arr(i, 7), "+")
   
10.         st1 = Split(st(0), "-")(0)
    
11.         For x = 0 To UBound(st)
    
12.             m = m + 1
    
13.             s = IIf(x = 0, st(0), st1 & "-" & st(x))
    
14.             For j = 1 To UBound(arr, 2)
    
15.                 brr(m, j) = arr(i, j)
    
16.             Next
    
17.             brr(m, 7) = s
    
18.         Next
    
19.     Next
    
20.     With Sheets("Sheet2")
    
21.         .UsedRange = ""
    
22.         .[a1].Resize(m, UBound(arr, 2)) = brr
    
23.     End With
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

cjc209

yanglinzi

请测试。。。

yanglinzi

请测试。。。

crudeoil123

ykcbf1100 发表于 2024-2-2 15:26
附件供参考。。。

谢谢，帮我解决了

crudeoil123

yanglinzi 发表于 2024-2-2 16:21
请测试。。。

谢谢帮助。可用啊

tanglf188

参与一下

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, cr, i&, j&, k&, r&, strSplit$
   
    Application.ScreenUpdating = False
   
    ar = ActiveSheet.UsedRange.Value
    ReDim br(1 To UBound(ar) * 10, 1 To UBound(ar, 2))
    For i = 1 To UBound(ar)
        strSplit = Mid(ar(i, 7), 3)
        cr = Split(strSplit, "+")
        For j = 0 To UBound(cr)
            r = r + 1
            For k = 1 To UBound(ar, 2)
                br(r, k) = ar(i, k)
            Next k
            br(r, 7) = ar(i, 5) & "-" & cr(j)
        Next j
    Next i
   
    With Sheets(2)
        .Cells.Delete
        .[A1].Resize(r, UBound(br, 2)) = br
        .Activate
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub