Vba 从excel中单个单元格的行中提取不同的值

您好，我有一个excel电子表格，在单个单元格中包含以下格式的行

[2013-12-01 00:29:36.45] ALL 000000000000 GLOBAL_SCOPE AUDIT: User [XXXXXX04] logged off.
[2013-12-01 00:29:55.292] ALL 000000000000 GLOBAL_SCOPE AUDIT: User [XXXXX05] authenticated via public key.
[2013-12-01 00:29:55.736] ALL 000000000000 GLOBAL_SCOPE AUDIT: User [xxx03] is opening file [/Inbox/AXS02XXXXXXX.AXS_RECON.IRF7171_EFTDR20131130.txt.p7] for transfer.
[2013-12-01 00:30:02.453] ALL 000000000000 GLOBAL_SCOPE AUDIT: User [xxxx05] authenticated via public key.
[2013-12-01 00:30:35.387] ALL 000000000000 GLOBAL_SCOPE AUDIT: User [sfdsf03] logged off.

我只想从包含单词Inbox的行中提取3个值。基本上，我想要的输出如下，分为3列

例如：-

请注意，用户名，即用户[x]值不同，每行的长度也不同。请帮忙

---

谢谢大家!

如果Excel工作表中已有数据，我想知道为什么需要VBA。也可以使用以下公式：

=IF(ISERROR(FIND("Inbox";A1));
   "";
   MID(A1;13;8)&" "&
     MID(A1;FIND("User";A1)+6;FIND("]";A1;FIND("User";A1))-FIND("User";A1)-6)&" "&
     MID(A1;FIND("Inbox";A1)+6;FIND("]";A1;FIND("Inbox";A1))-FIND("Inbox";A1)-6)
 )

如果文本中有“收件箱”一词，那么您将使用三次MID从文本中提取这三个部分。要找到MID的正确起点和字符数，请使用“查找”

---

如果您仍然希望在VBA中执行此操作，那么解决方案看起来会很相似，只是您必须使用InStr而不是FIND。

以下是两个VBA解决方案。第一个是用户定义的函数，它将所需的段提取到公式所在的单元格中。代码中定义了不同的索引

第二个是宏，它从A2开始处理a列中的条目，并将三个段解析为相邻的三列。不确定哪一个对你更合适

它们都使用正则表达式来获得不同的子字符串

两者都进入常规模块

功能：

---

您是否尝试过任何代码？如果是，结果如何？如果您不知道从哪里开始，我建议您研究For循环和InStr函数。

=IF(ISERROR(FIND("Inbox";A1));
   "";
   MID(A1;13;8)&" "&
     MID(A1;FIND("User";A1)+6;FIND("]";A1;FIND("User";A1))-FIND("User";A1)-6)&" "&
     MID(A1;FIND("Inbox";A1)+6;FIND("]";A1;FIND("Inbox";A1))-FIND("Inbox";A1)-6)
 )

Option Explicit
'Returns the three components
'  Index 1 = Time
'  Index 2 = User
'  Index 3 = inbox file
Function ParseInbox(S As String, Index As Long) As Variant
    Dim RE As Object, MC As Object

'Check that Index is proper
If Index < 1 Or Index > 3 Then
    ParseInbox = CVErr(xlErrNum)
    Exit Function
End If
Set RE = CreateObject("vbscript.regexp")
With RE
    .ignorecase = True
    .MultiLine = True
    .Pattern = "^.*((?:\d{2}:\d{2}:)\d{2}).*User\s*\[([^]]+).*Inbox/([^]]+)"
    If .test(S) = True Then
        Set MC = .Execute(S)
        ParseInbox = MC(0).submatches(Index - 1)
    End If
End With
End Function

Sub ProcInbox()
'Assumes Data in Column A; starts in A2, and
'   to be split into columns B, C & D
    Dim RE As Object, MC As Object
    Dim S As String
    Dim vSrc As Variant, vRes() As Variant
    Dim rRes As Range
    Dim I As Long, J As Long

'Set upper left corner for results
Set rRes = Range("B1")

'Get data
vSrc = Range("a2", Cells(Rows.Count, "A").End(xlUp))

'Dim Results Array
    If IsArray(vSrc) Then
        ReDim vRes(1 To UBound(vSrc) + 1, 1 To 3)
    Else
        ReDim vRes(1 To 2, 1 To 3)
    End If
vRes(1, 1) = "Time"
vRes(1, 2) = "User"
vRes(1, 3) = "Inbox File"

 Set RE = CreateObject("vbscript.regexp")
 With RE
    .ignorecase = True
    .MultiLine = True
    .Pattern = "^.*((?:\d{2}:\d{2}:)\d{2}).*User\s*\[([^]]+).*Inbox/([^]]+)"

    If IsArray(vSrc) Then
        For I = 1 To UBound(vSrc)
            S = vSrc(I, 1)
            If .test(S) = True Then
                Set MC = .Execute(S)
                For J = 0 To 2
                    vRes(I + 1, J + 1) = MC(0).submatches(J)
                Next J
            End If
        Next I
    Else
        S = vSrc
            If .test(S) = True Then
                Set MC = .Execute(S)
                For J = 0 To 2
                    vRes(2, J + 1) = MC(0).submatches(J)
                Next J
            End If
    End If
End With

Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2))
rRes.EntireColumn.Clear
rRes = vRes
rRes.EntireColumn.AutoFit
End Sub