问删除字符串列表后右边的所有内容。

EN

Debug.print GetLeftPart ("TA COCO TROP 16.9OZ")

Function GetLeftPart (stringToCheck As String) as string
   Dim regex As New RegExp
   Dim regmatch As MatchCollection
   regex.Pattern = "\s\d"
   Set regmatch = regex.Execute(stringToCheck)
   GetLeftPart = Left(stringToCheck , regmatch.Item(0).FirstIndex)
End function

Sub KeepItem()

Dim itemDescr As Range
Dim Rng As Range
Dim xChar As Variant
Dim ele As Variant
Dim iFoundAt As Integer
Dim xValue As String

Set itemDescr = Range("$D:$D")
xChar = Array(" 1", " 2", " 3", " 4", " 5", " 6", " 7", " 8", " 9", " .")

For Each Rng In itemDescr
    iFoundAt = 0
    xValue = Rng.Value
    'find if this is a line we are interested in
    If xValue = "" Then GoTo continue 'Question - do you want to continue or stop. if stop replace continue with exit for
    For Each ele In xChar
        iFoundAt = InStr(xValue, ele)
        If iFoundAt > 0 Then Exit For
    Next
    If iFoundAt > 0 Then Rng.Value = Left(xValue, iFoundAt - 1)
continue:

Next

End Sub

Sub RemoveNumOnwards()
Dim X As Long, Y As Long
For X = 1 To Range("D" & Rows.Count).End(xlUp).Row
    For Y = 0 To 9
        Range("D" & X).Formula = Trim(Split(Range("D" & X).text, Y)(0))
    Next
Next
End Sub

Sub RemoveNumOnwards()
Dim X As Long, Y As Long, xChar As Variant
xChar = Array(" 1", " 2", " 3", " 4", " 5", " 6", " 7", " 8", " 9", " .")
For X = 1 To Range("D" & Rows.Count).End(xlUp).Row
    For Y = LBound(xChar) To UBound(xChar)
        Range("D" & X).Formula = Trim(Split(Range("D" & X).text, xChar(Y))(0))
    Next
Next
End Sub