Excel VBA извлекает определенные данные из столбца смешанных данных

Question

У меня есть список шин из Интернета, длина списка составляет 5000 строк в одном столбце.Мне нужно извлечь из каждой строки данные, выделенные BOLD, в идеале в следующий столбец

ПРИМЕР ШИН

• LS388 (145/70 R13 71T )
• LS388 (155/65 R13 73T )
• LS388 (155/65 R14 75T )
• 4 сезона (155 /65 R14 75T )
• CT6 (155/70 R12 104N ) 72EE
• LS388 (155/70 R13 75T )

Проблема в том, что число может быть между 59 и 120, а буква может быть HTVRNXZ и так далее.Кроме того, текст может находиться в любом месте строки данных, не всегда ближе к концу, как показано.

Может быть 100 вариантов для поиска и

Вместо того, чтобы иметь одну строку кода для поиска LIKE 71T для каждой линии шин, могу ли я использоватьИсходная таблица этих вариаций и ссылки на них по одному в коде это какой-то цикл?или другие предложения, если в VBA оценили

На данный момент у меня есть этот код VBA для каждого возможного варианта, одна строка для каждого варианта.

ElseIf ActiveCell.Value Like "*79S*" Then
ActiveCell.offset(0,1).Value = "79S"

Answer 1

Я рекомендую использовать регулярные выражения для этого, если вам нужно сделать это с VBA.Есть довольно хорошее объяснение на Как использовать регулярные выражения (Regex) в Microsoft Excel как внутри ячейки, так и в циклах .

В качестве шаблона вы можете использовать что-то вроде .+\(.+ (.+)\).* (см. https://regex101.com/r/jK1zKc/1/)

Для ручного решения
Используйте Разделение текста на разные столбцы с помощью мастера преобразования текста в столбцы для разделения на столбцы по пробелам.

Затем просто замените ")" на "" в столбце D.

---

Или выполните ручное решение сVBA (при условии, что ваши данные в столбце A):

Option Explicit

Sub SplitAndDelet()
    Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
        ")", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _
        , TrailingMinusNumbers:=True
    Range("A:C,E:E").Delete Shift:=xlToLeft
End Sub

Answer 2

Если вы хотите сделать это в vba, вы можете настроить массив шин и просмотреть их для каждой ячейки.например, если у вас есть это на вашем листе;

вы можете сделать что-то вроде этого;

Public Sub FindTyres()

' Column to Loop
Dim col As String
col = "B"

' rows to Loop
Dim startRow As String
Dim endRow As String
startRow = "2"
endRow = "7"

' Get list of Tyres
Dim tyresArr()
tyresArr = getTyresArr()

' Set Range to Loop
Dim rng As Range, cell As Range
Set rng = Range(col & startRow & ":" & col & endRow)

' Looping through Array params
Dim tyre As Variant

' Loop through Cells
    For Each cell In rng
       currentCellVal = cell.Value

       ' Loop through tyres
       For Each tyre In tyresArr

            Debug.Print tyre
            ' if you find it do something
             If InStr(1, currentCellVal, CStr(tyre)) <> 0 Then
                 MsgBox "Value " & CStr(tyre) & " Contained in Cell " & cell.Address
                 Exit For
             End If

       Next tyre


    Next cell



End Sub

Private Function getTyresArr()

Dim tyresArr(3)


tyresArr(0) = "71T"
tyresArr(1) = "73T"
tyresArr(2) = "75T"
tyresArr(3) = "104N"

getTyresArr = tyresArr

End Function

Обратите внимание на этопредполагается, что у вас будет только один код шины на линию.Вы можете получить некоторые ложные срабатывания, если эти строки существуют по другим причинам.вам нужно будет ввести все коды в функцию, которая возвращает массив.

Answer 3

Вставьте эту формулу в ячейку, если предполагается, что ваша строка присутствует в столбце А. Вы можете изменить ее, если это не так, и проверить, сколько она извлекает.

=MID(A1,SEARCH(" ",A1,SEARCH("R1?",A1))+1,SEARCH(")",A1)-SEARCH(" ",A1,SEARCH("R1?",A1))-1)

отфильтровать оставшиесянайдите в них что-то общее и дайте мне знать, и мы сможем построить другую формулу для этих клеток.