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 Expressions 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

试试这个，对于范围内的每个单元格，它使用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

编辑：刚看到关于小数点的注释，这里是更新后的代码：

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

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

2 个答案: