使用 Excel VBA 從單元格中提取文本

Question

我希望從 Excel 的列中提取多個文本值，並用這些文本值填充另一列。

更具體地說，我希望提取 STLS 票號。

例如，一行可能包含“ABCD-4, STLS-5644, ABBD-33, STLS-421”，另一行可能包含“ABB-567, STLS-56435”，另一行可能不包含 STLS 票證。

解決這個問題的最佳方法是什么？

Answer 1

你可以試試這段代碼：

Option Explicit

Sub testExtract()

  Dim i As Long, j As Long, jUp As Long, lFirstRow As Long, lLastRow As Long
  Dim lColFrom As Long, lColTo As Long, nTicks As Long
  Dim str1 As String

  Dim varArray

  '
  ' define source column number and the destination one:
  '
  lColFrom = 1
  lColTo = 2

  '
  ' initialize range to analyze:
  '
  lFirstRow = 1
  lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

  '
  ' loop over the rows:
  '
  For i = lFirstRow To lLastRow
    '
    ' split the string in the cell in an array:
    '
    varArray = Split(Cells(i, lColFrom).Value, ",")
    jUp = UBound(varArray)
    nTicks = 0
    str1 = ""
    '
    ' check the array element by element if we have some ticket:
    '
    For j = 0 To jUp
      '
      ' trim spaces:
      '
      varArray(j) = Trim(varArray(j))

      '
      ' check if we have ticks and count them:
      '
      If (InStr(1, varArray(j), "STLS-") > 0) Then
        If (nTicks > 0) Then
          str1 = str1 & ", "
        End If
        str1 = str1 & varArray(j)
        nTicks = nTicks + 1
      End If
    Next

    '
    ' save ticks:
    '
    If (str1 <> "") Then
      Cells(i, lColTo).Value = str1
    End If

  Next

End Sub

Answer 2

If your Excel has the FILTERXML function (windows Excel 2013+) and the TEXTJOIN function, you don't need VBA.

您可以使用：

=IFERROR(TEXTJOIN(",",TRUE,FILTERXML("<t><s>" & SUBSTITUTE(A1,",","</s><s>")&"</s></t>","//s[contains(.,'STLS')]")),"")

如果你沒有這些功能，你可以使用這個 VBA UDF：

Option Explicit
Function getTickets(s As String, ticket As String) As String
    Dim v, w, x, col As Collection, i As Long
v = Split(s, ",")
Set col = New Collection
For Each w In v
    If Trim(w) Like ticket & "*" Then col.Add Trim(w)
Next w

i = 0

If col.Count = 0 Then
    getTickets = ""
Else
    ReDim x(col.Count - 1)
    For Each w In col
        x(i) = w
        i = i + 1
    Next w
    getTickets = Join(x, ",")
End If
End Function