Извлечение текста из ячейки с помощью Excel VBA

Question

Я хочу извлечь несколько текстовых значений из столбца в Excel и заполнить другой столбец этими текстовыми значениями.

Чтобы быть более точным c, я хочу извлечь номера билетов STLS.

Например, одна строка может содержать «ABCD-4, STLS-5644, ABBD-33, STLS-421 ", другая строка может содержать" ABB-567, STLS-56435 ", а другая строка может не содержать билетов STLS.

Каков наилучший способ решения этой проблемы?

Answer 1

Если ваш Excel имеет функцию FILTERXML (windows Excel 2013+) и функцию TEXTJOIN, вам не нужен 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

Answer 2

Вы можете попробовать этот код:

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