Удалите все вправо после списка строк

Question

Я пытаюсь удалить все вправо после списка конкретных строк для столбца.

Sub KeepItem() 

Dim itemDescr As Range 
Dim Rng As Range 
Dim xChar As Variant 

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

For Each Rng In itemDescr 
    xValue = Rng.Value 
    Rng.Value = Left(xValue, InStr(xValue, xChar) - 1) 
Next 

End Sub 

Этот

VITA COCO TROP 16.9OZ 
ARGO CAROLINA HNY 13.5OZ GLS 
ARGO GRN TEA GNGR 13.5OZ GLS 
ARGO HIBISC SNGRIA 13.5OZ GLS 
ARGO MOJI TEA 13.5OZ GLS 

Должно выглядеть так:

VITA COCO TROP 
ARGO CAROLINA HNY 
ARGO GRN TEA GNGR 
ARGO HIBISC SNGRIA 
ARGO MOJI TEA 

Я начинающий программист VBA и я ценю ваше мнение.

Ошибка: (тип несовпадения):

Rng.Value = Left(xValue, InStr(xValue, xChar) - 1) 

Answer 1

Будет ли это работать для вас, если вы хотите получить текст перед номером вхождение?

вам нужно добавить ссылку на Microsoft VBScript Reglar Выражения 5.5

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 

Answer 2

Попробуйте это, для каждой ячейки в диапазоне она от 0 до 9, используя команду Split, чтобы разделить строку на массив, мы хотим, чтобы все было слева, поэтому мы берем первый элемент (индекс 0), а затем обрезаем пробел.

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 

Edit: Просто увидел вашу записку о десятичной точке, здесь обновленный код:

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