分拆

cnmlgb9998

PQ法！ 简单易操作！

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, vResult$(), i&, j&, aMatch As Object
   
    ar = Range("D1", Cells(Rows.Count, "E").End(xlUp)).Value
    ReDim vResult(1 To UBound(ar), 3)
    br = Split("单位名称 内容 发票号 代码")
   
    For j = 0 To UBound(br)
        vResult(1, j) = br(j)
    Next j
   
    With CreateObject("VBScript.RegExp")
        .Pattern = "([\u4e00-\u9fa5\,]+)([\d+\,\-]+)"
        For i = 2 To UBound(ar)
            br = Split(ar(i, 1))
            vResult(i, 0) = br(0)
            If .test(br(1)) Then
                Set aMatch = .Execute(br(1))(0)
                vResult(i, 1) = aMatch.submatches(0)
                vResult(i, 2) = aMatch.submatches(1)
            End If
            vResult(i, 3) = ar(i, 2)
        Next i
    End With
   
    Columns("K:N").Clear
    [K1].Resize(UBound(vResult), 4) = vResult
    Beep
End Sub

gwjkkkkk

请参考附件。。。

limonet

公式：=TEXTSPLIT(REPLACE(D2,MIN(FIND(ROW($1:$10)-1,D2&1/17)),0," ")," ")

limonet

发重复了，上代码吧。

Sub limonet()
    Dim i%
    With CreateObject("vbscript.regexp")
        .Pattern = "(.*?) (.*?)(\d+.*)"
        For i = 2 To 9
            Cells(i, "K").Resize(1, 3) = Split(.Replace(Cells(i, "D"), "$1￥$2￥$3"), "￥")
        Next i
    End With
End Sub

limonet

还是上传不了附件，换了电脑
另一公式=TRIM(MID(SUBSTITUTE(REPLACE($D2,MIN(FIND(ROW($1:$10)-1,$D2&1/17)),0," ")," ",REPT(" ",99)),1+(COLUMN(A:A)-1)*99,99))

limonet

关键字：￥￥￥

ddz79101

swl4561255 发表于 2024-3-28 15:30
公式法，详见附件。

谢谢老师！成功分拆

ddz79101

cnmlgb9998 发表于 2024-3-28 16:36
PQ法！ 简单易操作！

谢谢老师！

ddz79101

gwjkkkkk 发表于 2024-3-28 19:42
请参考附件。。。

谢谢老师！成功分拆