VBA Excel-拆分字符串并在两个字符之间提取

Question

我在excel中有一个字符串，如下所示：

String1 = "L100;G50;XYZ12,5;E11/11/2018;NF1;Osomefreetext"

我要提取此字符串的一部分并将其另存为变量：

var1 = 100 (part of the string between "L" and next ";"
var2 = 50 (part of the string between "G" and next ";"
var3 = 12 (part of the string between "XYZ" and next ";"
var4 = 11/11/2018 (part of the string between "E" and next";"
var5 = 1 (part of the string between "NF" and next ";"
var6 = somefreetext (part of the string between "O" and next ";"

我知道VBA拆分功能，它将根据选择的定界符（在我的情况下为“;”）拆分我的字符串

Split(String1, ";")

但是，不同子字符串的顺序不是恒定的，例如，“ G”部分可以位于“ L”部分之前，或者“ XYZ”部分可以位于末尾。

因此，如何基于开始模式提取不同的子字符串，但仍要考虑“;”定界符。

Answer 1

这是使用{ "kind": "youtube#channelListResponse", "etag": "\"XI7nbFXulYBIpL0ayR_gDh3eu1k/WWRI52WjRpAqah0nCwndMcTUf6U\"", "pageInfo": { "totalResults": 0, "resultsPerPage": 0 }, "items": [ ] } 运算符的一种方法：

Like

输出：

Sub test()
    Dim var1, var2, var3, var4, var5, var6 'as variant
    Dim string1 As String, s As String
    Dim items As Variant
    Dim i As Long

    string1 = "L100;G50;XYZ12,5;E11/11/2018;NF1;Osomefreetext"
    items = Split(string1, ";")

    For i = 0 To UBound(items)
        s = items(i)
        If s Like "L*" Then
            var1 = Mid(s, 2)
        ElseIf s Like "G*" Then
            var2 = Mid(s, 2)
        ElseIf s Like "XYZ*" Then
            var3 = Mid(s, 4)
        ElseIf s Like "E*" Then
            var4 = Mid(s, 2)
        ElseIf s Like "NF*" Then
            var5 = Mid(s, 3)
        ElseIf s Like "O*" Then
            var6 = Mid(s, 2)
        'Else error trapping code
        End If
    Next i
    Debug.Print "Extracted " & Join(Array(var1, var2, var3, var4, var5, var6), ", ")

End Sub

Answer 2

尝试

Sub test()
    Dim String1 As String, s As String
    Dim vR(), vS
    Dim i As Integer, j As Integer

    String1 = "L100;G50;XYZ12,5;E11/11/2018;NF1;Osomefreetext"

    vS = Split(String1, ";")
    ReDim vR(UBound(vS))
    For i = 0 To UBound(vS) - 1
        s = Split(vS(i), ",")(0)
        For j = 1 To Len(s)
            If Mid(s, j, 1) Like "[a-zA-Z]" Then
               s = Replace(s, Mid(s, j, 1), "")
               j = j - 1
            End If
        Next j
        vR(i) = s
    Next i
    s = vS(i)
    vR(i) = Right(s, Len(s) - 1)
    Range("a1").Resize(1, i + 1) = vR
End Sub

**结果

vR（0）= 100

vR（1）= 50

vR（2）= 12

vR（3）= 11/11/2018

vR（4）= 1

vR（5）=一些自由文本

Answer 3

在VBE中，添加一个新的类模块（Alt + I，C）并粘贴以下内容。

CExtract class module

Option Explicit

Private pL As Long
Private pG As Long
Private pXYZ As Long
Private pE As Date
Private pNF As Long
Private pO As String

Public Property Get L() As Long
    L = pL
End Property
Public Property Let L(Value As Long)
    pL = Value
End Property

Public Property Get G() As Long
    G = pG
End Property
Public Property Let G(Value As Long)
    pG = Value
End Property

Public Property Get XYZ() As Long
    XYZ = pXYZ
End Property
Public Property Let XYZ(Value As Long)
    pXYZ = Value
End Property

Public Property Get e() As Date
    e = pE
End Property
Public Property Let e(Value As Date)
    pE = Value
End Property

Public Property Get NF() As Long
    NF = pNF
End Property
Public Property Let NF(Value As Long)
    pNF = Value
End Property

Public Property Get O() As String
    O = pO
End Property
Public Property Let O(Value As String)
    pO = Value
End Property

使用“属性”窗口（Alt + V，W），将该类重命名为CExtract。

填充并使用像这样的新类。

Module1 code

Option Explicit

Sub main()
    Dim extract As New CExtract, string1 As String

    string1 = "L100;G50;XYZ12,5;E11/11/2018;NF1;Osomefreetext"

    buildExtract extract, string1

    Debug.Print extract.e
    Debug.Print extract.G
    Debug.Print extract.L
    Debug.Print extract.NF
    Debug.Print extract.O
    Debug.Print extract.XYZ

End Sub

Sub buildExtract(ByRef ext As CExtract, str As String)

    Dim i As Long, arr As Variant

    arr = Split(str, Chr(59))

    For i = LBound(arr) To UBound(arr)
        Select Case Asc(arr(i))
            Case 69 'E
                ext.e = CDate(Mid(arr(i), 2))
            Case 71 'G
                ext.G = CLng(Mid(arr(i), 2))
            Case 76 'L
                ext.L = CLng(Mid(arr(i), 2))
            Case 78 'NF
                ext.NF = CLng(Mid(arr(i), 3))
            Case 79 'O
                ext.O = Mid(arr(i), 2)
            Case 88 'XYZ
                ext.XYZ = CLng(Mid(arr(i), 4))
            Case Else
                Debug.Print "rogue element:" & arr(i)
        End Select
    Next i


End Sub

Results