分割函数 - 按字符串分割单元格

Question

我正在尝试将合并的信息从一个单元格拆分为单独的单元格。

一个单元格：

<头>

amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750

分割数据：（我想将每个部分导出到另一个单元格中）

<头>

数量：2	价格：253,18	price2:59,24 欧盟	状态：WBB NAS MRR OWA PXA	分钟：1	选择：3	类别：PNE	代码 z:195750

我不能简单地通过查找空格、区分大小写的状态单元格来进行划分| status:WBB NAS MRR OWA PXA| 数据范围不同，空格不能分割。

拆分（表达式 [,delimiter] [,limit] [,compare] ）

    Sub Split_VBA()
'Create variables
Dim MyArray() As String, MyString As String, N As Integer, Temp As String

MyString = B2 ' TRYING TO GET DATA FROM CELL B2 TO SPLIT IT
'Use the split function to divide the string using a string "price:"
MyArray = Split(MyString, "price:")

    Dim arr() As String
    ' Split the string to an array
    arr = Split(B2, "price:") 'try to divide first part of data when appears string 'price:'

   For N = 0 To UBound(MyArray)
     'place each array element plus a line feed character into a string
    Temp = Temp & MyArray(N) & vbLf
Next N
'   I WOULD LIKE TO PROVIDE RESULT IN A ROW NOT IN A COLUMN
Range("A1") = Temp

End Sub

到目前为止，这个 VBA 代码似乎有点超出我的能力，据我检查一些在线可用示例，尝试提供如下代码，但我被卡住了，我在此向亲爱的社区请教一些建议。

Answer 1

由于顺序相同，一种方法是简单地搜索相邻的键名并解析出中间的内容：

Sub g()

    Dim stringValue As String
    
    stringValue = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
    
    Debug.Print getPart(stringValue, "amount", "price")
    Debug.Print getPart(stringValue, "price", "price2")
    Debug.Print getPart(stringValue, "price2", "status")
    Debug.Print getPart(stringValue, "status", "min")
    Debug.Print getPart(stringValue, "min", "opt")
    Debug.Print getPart(stringValue, "opt", "category")
    Debug.Print getPart(stringValue, "category", "code z")
    Debug.Print getPart(stringValue, "code z", "", True)

End Sub

Function getPart(value As String, fromKey As String, toKey As String, Optional isLast As Boolean = False) As String
    Dim pos1 As Long, pos2 As Long
    
    pos1 = InStr(1, value, fromKey & ":")
    
    If (isLast) Then
        pos2 = Len(value)
    Else
        pos2 = InStr(pos1, value, toKey & ":")
    End If
    
    getPart = Trim$(Mid$(value, pos1, pos2 - pos1))
End Function

---

amount:2
price:253,18
price2:59,24 EU
status:WBB NAS MRR OWA PXA
min:1
opt:3
category: PNE
code z:19575

Answer 2

多种选择：

• 您展示的模式是每个拆分都可以由一个单词（无空格）后跟一个冒号来确定。
  • 这可以轻松复制为正则表达式模式，并在 VBA 中实现。
• 但是，如果您的拆分词可能有空格，则您需要不同的解决方案：

VBA 正则表达式解决方案

'Set Reference to Microsoft VBScript Regular Expressions 5.5
Option Explicit
Function splitIt(S)
    Dim RE As RegExp, MC As MatchCollection, M As Match
    Dim vResult As Variant, I As Long
    Const sPat As String = "\w+:.*?(?=(?:\w+:)|$)"
    
Set RE = New RegExp
With RE
    .Global = True
    .Pattern = sPat
    If .Test(S) = True Then
        Set MC = .Execute(S)
        ReDim vResult(1 To MC.Count)
        I = 0
        For Each M In MC
            I = I + 1
            vResult(I) = M
        Next M
    Else
        vResult = "split pattern not present"
    End If
End With

splitIt = vResult
End Function

这个函数输出一个水平的值数组。在具有动态数组的 Excel 版本中，这将 Spill 进入相邻的单元格。在旧版本中，您可能必须将其作为数组公式输入；对每个元素使用 INDEX；或将其重写为 Sub 以输出到特定单元格

拆分 word: 正则表达式说明

\w+:.*?(?=(?:\w+:)|$)

• Match a single character that is a “word character” \w+
  • Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
• Match the colon character :
• Match any single character that is NOT a line break character .*?
  • Between zero and unlimited times, as few times as possible, expanding as needed (lazy) *?
• Assert that the regex below can be matched starting at this position (positive lookahead) (?=(?:\w+:)|$)
  • Match this alternative (?:\w+:)
    • Match the regular expression below (?:\w+:)
      • Match a single character that is a “word character” \w+
        • Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
      • Match the colon character :
  • Or match this alternative $
    • Assert position at the very end of the string $

创建于 RegexBuddy

Answer 3

拆分 - 加入 - 重新拆分

不是编码固定类别，这种后期方法在执行Split操作之前从基本字符串中读取任何类别（只有异常{{ 1}} 将在额外的步骤中处理）：

• code z 定义分隔符
• 1 标记基本字符串（通过空格 2 拆分操作）并在连接的类别元素前添加管道字符 " " 的前缀
• "|" 通过最终的管道 3
返回结果数组

Split

Answer 4

与 Alex K. 的答案具有类似逻辑的版本，因此所有功劳都归功于他，使用两个数组并将处理结果放在一行中：

Sub extractFromString()
  Dim arrStr, arrFin, strInit As String, i As Long, iStart As Long, iEnd As Long, k As Long
  
  strInit = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
  arrStr = Split("amount:,price:,price2:,status:,min:,opt:,category:,code z:", ",")
  ReDim arrFin(UBound(arrStr))
  For i = 0 To UBound(arrStr)
        iStart = InStr(strInit, arrStr(i))
        If i <> UBound(arrStr) Then
            iEnd = InStr(iStart, strInit, arrStr(i + 1))
        Else
           arrFin(k) = Mid(strInit, iStart): Exit For
        End If
        arrFin(k) = RTrim(Mid(strInit, iStart, iEnd - iStart)): k = k + 1
  Next i
  'use here the first cell of the row where the processing result to be returned
  Range("A22").Resize(1, UBound(arrFin) + 1) = arrFin
End Sub

Answer 5

我会研究一些正则表达式，例如：

[a-z\d ]+:[ ,A-Z\d]+

查看在线demo

• [a-z\d ]+ - 1+ 个小写字母、空格或数字字符。
• : - 文字冒号。
• [ ,A-Z\d]+ - 1+ 空格、逗号、大写字母或数字。

---

VBA：

Sub Test()

Dim str As String: str = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
Dim matches As Object

With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "[a-z\d]+(?: [a-z\d]+)?:[ ,A-Z\d]+"
    If .Test(str) = True Then
        Set matches = .Execute(str)
        For Each match In matches
            Debug.Print Trim(match)
        Next
    End If
End With

End Sub

Answer 6

拆分/连接/过滤数组的另一个版本：

Sub extractFromStr()
  Dim arrStr, arrFin, strInit As String, i As Long, k As Long
  Dim arr1, arr2, firstEl As String, secEl As String
  
  strInit = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
  arrStr = Split(strInit, ":")           'split the string by ":" character
  ReDim arrFin(UBound(arrStr))           'ReDim the final array at the  same number of elements
  For i = 0 To UBound(arrStr) - 1        'iterate between the array elements (except the last)
        arr1 = Split(arrStr(i), " ")     'split the i element by space (" ")
        arr2 = Split(arrStr(i + 1), " ") 'split the i + 1 element by space (" ")
        If i = 0 Then                    'for the first array element:
             firstEl = arrStr(i)         'it receives the (first) array element value
        Else                             'for the rest of array elements:
            'extract firstEl (category) like first arr1 element, except the case of 'code z' which is extracted in a different way
             firstEl = IIf(i = UBound(arrStr) - 1, arr1(UBound(arr1) - 1) & " " & arr1(UBound(arr1)), arr1(UBound(arr1)))
        End If
        'in order to remove array elements, the code transformes the one to be removed in "|||":
        'it could be anything, but "|||" is difficult to suppose that it will be the text of a real element...
        arr2(UBound(arr2)) = "|||": If i = UBound(arrStr) - 2 Then arr2(UBound(arr2) - 1) = "|||"
        'extract the secEl (the value) by joining the array after removed firstEl:
        secEl = IIf(i = UBound(arrStr) - 1, arrStr(UBound(arrStr)), Join(Filter(arr2, "|||", False), " "))
        arrFin(k) = firstEl & ":" & secEl: k = k + 1 'create the processed element of the array to keep the result
  Next i
  'use here the first cell of the row where the processing result to be returned. Here, it returns on the first row:
  Range("A1").Resize(1, UBound(arrFin) + 1) = arrFin
End Sub