|
参与一下。。。- Sub ykcbf() '//2024.8.11
- Set reg = CreateObject("VBScript.Regexp")
- With Sheets("销售订单申请")
- r = .Cells(Rows.Count, 1).End(3).Row
- arr = .[a1].Resize(r, 5)
- End With
- With reg
- .Global = True
- .Pattern = "产品型号:(.*?) \| 数量:(.*?) \| 单价(含税):(.*?) \| 销售额(含税):(\d+(?=\.))"
- End With
- On Error Resume Next
- ReDim brr(1 To 1000, 1 To 8)
- For i = 2 To UBound(arr, 1)
- st = Split(Replace(arr(i, 5), ";", Chr(10)), Chr(10))
- For x = 0 To UBound(st)
- If st(x) <> "" Then
- s = st(x)
- If reg.test(s) Then
- Set mh = reg.Execute(s)
- n = 5
- m = m + 1
- For j = 1 To 4
- brr(m, j) = arr(i, j)
- Next
- brr(m, 5) = mh(0).submatches(0)
- brr(m, 6) = Val(mh(0).submatches(1))
- brr(m, 7) = Val(mh(0).submatches(2))
- brr(m, 8) = Val(mh(0).submatches(3))
- End If
- End If
- Next
- Next i
- With Sheets("结果")
- .UsedRange.Offset(1).ClearContents
- .Columns(1).NumberFormatLocal = "@"
- .[a2].Resize(m, 8) = brr
- .[a2].Resize(m, 8).Borders.LineStyle = 1
- ActiveWindow.DisplayZeros = False
- End With
- End Sub
复制代码
|
|