Question

我在互联网上有一份Tires列表，该列表在一列中长5,000行。我需要将每一行中的数据以理想的粗体形式提取到下一列中

轮胎示例

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之间，并且字母可能是H T V R N X Z等。文本也可以位于数据行内的任何位置，而不总是如图所示。

可能有100个变体要查找和

除了可以用一行代码来搜索每行轮胎的 LIKE 71T 之外，我可以使用这些变化形式的源表并在代码中逐一引用它们吗？循环？或在VBA中赞赏的其他建议

目前，对于每种可能的变体我都有此VBA代码，对于每种变体，只有一行。

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

Answer 1

将此公式插入一个单元格中（假设您的字符串在A列中），如果不是这种情况，则可以更改它，并检查提取了多少。

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

过滤掉剩下的那些，找到它们中的一些共同点，让我知道，我们可以为这些单元建立另一个公式。

Answer 2

如果需要使用VBA，我建议为此使用正则表达式。有一个很好的解释 How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops。

作为模式，您可以使用类似.+\(.+ (.+)\).*（请参见https://regex101.com/r/jK1zKc/1/）

手动解决方案
使用Split text into different columns with the Convert Text to Columns Wizard将空格分隔成几列。

然后在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 3

如果要在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

请注意，这是假设您每行只会有一个轮胎代码。如果这些字符串由于其他原因而存在，您可能会得到一些误报。您需要将所有代码输入返回数组的函数中。

Excel VBA从混合数据列中提取特定数据

3 个答案: