使用VBA在单元格中查找字符串

Question

我已经为此疯狂了一整天，四处搜寻，可能是因为想得太聪明了所以完全卡住了。

我试图运行一个简单的if then语句

如果单元格包含“％”，我想做一件事，如果没有则做另一件事。出于我不理解的原因，我无法使其正常工作。我显然从其他地方借鉴了一些想法，但仍然无法使其正常工作。

复杂因素-我不想在整个列上运行它，只想在表格中运行，因此它嵌入在较大的子程序中，使用许多相对ActiveCells。我永远不知道我将在A列中的哪个位置遇到“％变化”，因此范围必须始终是可变的。当它遇到带有“％”的单元格时，我希望VBA / VBE执行不同的操作。所以

这里是原始数据的样子

Initial Value (6/30/06)

Value (12/31/06)

Net Additions (9/30/07)

Withdrawal (12/07)

Value (12/31/07)

Withdrawal (2008)

Value (12/31/08)

Addition (8/26/09)

Value (12/31/09)

Value (12/31/10)

Value (12/30/11)

Value (3/31/12)

% Change 1st Quarter

% Change Since Inception

但是当我运行以下代码时，它陷入了一个糟糕的循环中，本应该进入子程序的"If Then"部分，而不是"Else"部分。

Sub IfTest()
 'This should split the information in a table up into cells
 Dim Splitter() As String
 Dim LenValue As Integer     'Gives the number of characters in date string
 Dim LeftValue As Integer    'One less than the LenValue to drop the ")"
 Dim rng As Range, cell As Range
 Set rng = ActiveCell

Do While ActiveCell.Value <> Empty
    If InStr(rng, "%") = True Then
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "% Change")
        ActiveCell.Offset(0, 10).Select
        ActiveCell.Value = Splitter(1)
        ActiveCell.Offset(0, -1).Select
        ActiveCell.Value = "% Change"
        ActiveCell.Offset(1, -9).Select
    Else
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "(")
        ActiveCell.Offset(0, 9).Select
        ActiveCell.Value = Splitter(0)
        ActiveCell.Offset(0, 1).Select
        LenValue = Len(Splitter(1))
        LeftValue = LenValue - 1
        ActiveCell.Value = Left(Splitter(1), LeftValue)
        ActiveCell.Offset(1, -10).Select
    End If
Loop
End Sub

非常感谢您的帮助！

- Tommy Z

Answer 1

我将您的代码简化，以便测试单元格中是否存在“%”。一旦测试成功，您可以添加其余的代码。

请尝试以下代码：

Option Explicit


Sub DoIHavePercentSymbol()
   Dim rng As Range

   Set rng = ActiveCell

   Do While rng.Value <> Empty
        If InStr(rng.Value, "%") = 0 Then
            MsgBox "I know nothing about percentages!"
            Set rng = rng.Offset(1)
            rng.Select
        Else
            MsgBox "I contain a % symbol!"
            Set rng = rng.Offset(1)
            rng.Select
        End If
   Loop

End Sub

InStr函数将返回搜索文本在字符串中出现的次数。我改变了你的if测试来首先检查没有匹配项。

消息框和.Selects只是为了让你在逐步执行代码时看到发生了什么。一旦你使其工作，就可以将它们删除。

- Jon Crowell

---

这是我缺失的简单拼图。我还相对较新，所以没有想到（好吧，也许是不知道 :)）在if语句中使用set rng.offset的能力。那很棒，非常有帮助。我之前一直在使用true false而不是= 0来使用InStr函数，虽然我仍然不完全理解，但我很感激。非常感谢！ - Tommy Z

Answer 2

你从未改变rng的值，因此它始终指向初始单元格

将Set rng = rng.Offset(1, 0)复制到循环之前的新行中

另外，你的InStr测试将始终失败
True是-1，但InStr返回的值大于0时表示找到了字符串。更改测试以去除= True

新代码：

Sub IfTest()
 'This should split the information in a table up into cells
 Dim Splitter() As String
 Dim LenValue As Integer     'Gives the number of characters in date string
 Dim LeftValue As Integer    'One less than the LenValue to drop the ")"
 Dim rng As Range, cell As Range
 Set rng = ActiveCell

Do While ActiveCell.Value <> Empty
    If InStr(rng, "%") Then
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "% Change")
        ActiveCell.Offset(0, 10).Select
        ActiveCell.Value = Splitter(1)
        ActiveCell.Offset(0, -1).Select
        ActiveCell.Value = "% Change"
        ActiveCell.Offset(1, -9).Select
    Else
        ActiveCell.Offset(0, 0).Select
        Splitter = Split(ActiveCell.Value, "(")
        ActiveCell.Offset(0, 9).Select
        ActiveCell.Value = Splitter(0)
        ActiveCell.Offset(0, 1).Select
        LenValue = Len(Splitter(1))
        LeftValue = LenValue - 1
        ActiveCell.Value = Left(Splitter(1), LeftValue)
        ActiveCell.Offset(1, -10).Select
    End If
Set rng = rng.Offset(1, 0)
Loop

End Sub

- SeanC

---

非常好，感谢您对inStr测试的解释！那非常有帮助！ - Tommy Z

Answer 3

对于搜索程序，您应该考虑使用 Find、AutoFilter 或变体数组方法。范围循环通常太慢了，如果它们使用 Select 更糟。

下面的代码将在用户选择的范围内查找 strText 变量，然后将任何匹配项添加到范围变量 rng2 中，然后您可以进一步处理它们。

Option Explicit

Const strText As String = "%"

Sub ColSearch_DelRows()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim cel1 As Range
    Dim cel2 As Range
    Dim strFirstAddress As String
    Dim lAppCalc As Long


    'Get working range from user
    On Error Resume Next
    Set rng1 = Application.InputBox("Please select range to search for " & strText, "User range selection", Selection.Address(0, 0), , , , , 8)
    On Error GoTo 0
    If rng1 Is Nothing Then Exit Sub

    With Application
        lAppCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set cel1 = rng1.Find(strText, , xlValues, xlPart, xlByRows, , False)

    'A range variable - rng2 - is used to store the range of cells that contain the string being searched for
    If Not cel1 Is Nothing Then
        Set rng2 = cel1
        strFirstAddress = cel1.Address
        Do
            Set cel1 = rng1.FindNext(cel1)
            Set rng2 = Union(rng2, cel1)
        Loop While strFirstAddress <> cel1.Address
    End If

    If Not rng2 Is Nothing Then
        For Each cel2 In rng2
            Debug.Print cel2.Address & " contained " & strText
        Next
    Else
        MsgBox "No " & strText
    End If

    With Application
        .ScreenUpdating = True
        .Calculation = lAppCalc
    End With

End Sub

- brettdj

---

这对我未来非常有帮助，谢谢！ - Tommy Z