分列求助

风雨相随3

sheet 1分列.rar (12.89 KB, 下载次数: 18)

2023-1-20 10:22 上传

点击文件名下载附件

分列求助，文本里菜品个数并不固定。

ykcbf1100

这个适合正则。

fzxba

Sub test0()
  Dim ar, br(), strText As String
  Dim i As Long, j As Long, k As Long
  ar = Range("C6", Range("C6").End(xlDown))
  ReDim br(1 To UBound(ar), 1 To 60)
  For i = 1 To UBound(ar)
    j = 0
    strText = Trim(ar(i, 1))
    If Right(strText, 1) = "/" Then strText = Left(strText, Len(strText) - 1)
    ProcessData br, strText, i, j
    If j > k Then k = j
  Next
  Range("F11").Resize(UBound(br), k * 3) = br
End Sub

Function ProcessData(br(), strText$, posRow&, nCount&)
  Dim ar, strTemp As String
  Dim i As Long, posCol As Long
  i = InStr(strText, "数量") + 2
  i = InStr(i, strText, "/")
  If i Then strTemp = Left(strText, i) Else strTemp = strText
  If Len(strTemp) Then
    posCol = nCount * 3
    ar = Split(strTemp, ",单价")
    br(posRow, posCol + 1) = ar(0)
    br(posRow, posCol + 2) = Val(ar(UBound(ar)))
    br(posRow, posCol + 3) = Val(Split(ar(UBound(ar)), "数量")(1))
    nCount = nCount + 1
    strText = Replace(strText, strTemp, vbNullString)
    If Len(strText) Then ProcessData br, strText, posRow, nCount
  End If
End Function

风雨相随3

fzxba 发表于 2023-1-20 11:57
Sub test0()
  Dim ar, br(), strText As String
  Dim i As Long, j As Long, k As Long

运行错误。

fzxba

风雨相随3 发表于 2023-1-20 13:01
运行错误。

现有附件不会有错稍完善上附件.rar (23.26 KB, 下载次数: 7)

2023-1-20 13:12 上传

点击文件名下载附件

学习js宏

有wps可以运行，应该可以满足要求

taller

fzxba

ykcbf1100 发表于 2023-1-20 10:31
这个适合正则。

请不要给我送花！

风雨相随3

学习js宏 发表于 2023-1-20 13:24
有wps可以运行，应该可以满足要求

sheet JS分列.rar (13.86 KB, 下载次数: 2)

2023-1-20 15:37 上传

点击文件名下载附件

第一个“/"不是的。所以结果位移了一列。

zldccmx