使用VBA查找单元格内的string

我一直在为这一天疯狂着，search着高低，而且可能试图变得太可爱，所以我完全被困住了。

那么我试图运行一个简单的

如果一个单元格包含“％”，我希望它做一件事，如果不是另一件事。 由于我不明白的原因，我无法解决这个问题。 我清楚地从其他地方采取了一些想法，但仍然无法实现。

复杂的因素 – 我不想在整个列上运行这个表，只是一个表，所以它使用很多或相对ActiveCellsembedded到一个更大的子。 我永远不知道A列中哪里会碰到“％Change”，所以Range始终是可变的。 我想让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”中，而不是“Subse”的“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 

所有的帮助表示赞赏，谢谢！

Answer 1

我简化了代码，隔离了单元格中“％”的testing。 一旦你得到这个工作，你可以添加其余的代码。

尝试这个：

 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将返回search文本在string中出现的次数。 我改变了你的testing，先检查没有比赛。

消息框和.Selects只是简单地让你看到发生了什么，而你正在通过代码。 把它们拿出来，一旦你得到它的工作。

Answer 2

你永远不会改变rng的值，所以它总是指向最初的单元格

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

另外，你的InStrtesting总是失败
True是-1，但是当findstring时， InStr的返回值将大于0。 改变testing删除=真

新代码：

 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 

Answer 3

对于search例程，您应该使用Find ， AutoFilter或变体数组方法。 范围循环正常速度太慢，如果使用Select ，则会再次变差

下面的代码将在用户select的范围内查找strTextvariables，然后将任何匹配添加到范围variablesrng2 ，然后您可以进一步处理

 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