时间戳

首页 > 解决方案 > 如何将多个字符串提取到一个逗号分隔的字符串中？

excel - 如何将多个字符串提取到一个逗号分隔的字符串中？

问题描述

我找到了这个 VBA 代码。

目前提取的字符串被复制到它们自己的列中。

我想更新复制提取字符串的部分，以将所有提取的字符串放在同一列中（用逗号分隔）。

Option Explicit
Public Sub ExtractInfoFromSquareBrackets()
    Dim wksRaw As Worksheet
    Dim strPattern As String, strRaw As String, strMatch As String
    Dim rngAllRows As Range, rngCell As Range
    Dim lngLastRow As Long, lngIdx As Long
    Dim objMatches As Object
    Dim rgx As RegExp
    Set rgx = New RegExp
        
    'Set references up-front
    Set wksRaw = ThisWorkbook.Sheets("raw")
    strPattern = "(\[\S*?\])"
    With rgx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = strPattern
    End With
        
    'Find the last-occupied row on the raw sheet
    lngLastRow = wksRaw.Cells.Find(What:="*", LookIn:=xlFormulas, _
                                   SearchOrder:=xlByRows, _
                                   SearchDirection:=xlPrevious).Row
        
    'Get all the rows into a single range for easy looping
    With wksRaw
        Set rngAllRows = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
    End With
        
    'Loop through all the rows
    For Each rngCell In rngAllRows
        'Store the value from the cell for easy comparison
        strRaw = CStr(rngCell.Value)
            
        'If the string inside the cell hits our RegExp, start the operation
        If rgx.Test(strRaw) Then
                
            'Assign the matches inside the string to an object
            Set objMatches = rgx.Execute(strRaw)
                
            'Loop through the matches, removing the square brackets and
            'writing the results to the neighboring cells
            For lngIdx = 0 To (objMatches.Count - 1)
                strMatch = objMatches.Item(lngIdx)
                strMatch = Replace(strMatch, "[", "")
                strMatch = Replace(strMatch, "]", "")
                rngCell.Offset(0, lngIdx + 1).Value = strMatch
            Next lngIdx
        Else
            rngCell.Offset(0, 1) = "No square brackets found!"
        End If

    Next rngCell

    MsgBox "Completed!"
End Sub

标签： excelvba

解决方案

您可以将循环修改为：

        strMatch = vbnullstring
        For lngIdx = 0 To (objMatches.Count - 1)
            strMatch = strMatch & "," & objMatches.Item(lngIdx)
        Next lngIdx
        strMatch = Replace(strMatch, "[", "")
        strMatch = Replace(strMatch, "]", "")
        rngCell.Offset(0, 1).Value = Mid$(strMatch, 2)

推荐阅读