Найти строку в ячейке с помощью VBA

Question

Я заставляю себя сумасшедшим с этим в течение дня, искал высоко и низко, и, наверное, стараюсь быть слишком милым, так что я полностью застрял.

Я пытаюсь запустить простой, если затем

Если ячейка содержит «%» Я хотел бы, чтобы сделать одну вещь, а если нет другого. По причинам, которые я не понимаю, я не могу заставить его работать. Я ясно взял пару идей из других источников, но до сих пор не могу заставить его работать.

Усложняющие факторы. Я не хочу запускать это на весь столбец, просто таблицу, поэтому он встроен в более крупный блок, используя партии или относительные ActiveCells. Я никогда не знаю, где в столбце A я собираюсь запустить «% Change», поэтому Range всегда должен быть переменным. Я хочу, чтобы VBA/VBE делал что-то другое, когда дело касалось ячейки с «%» в ней. SO

Вот что выглядит исходные данные, как

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 

Вся помощь приветствуется, спасибо!

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 есть просто для вас, чтобы увидеть, что происходит, когда вы переходите через код. Выньте их, как только вы заработаете.

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 

Answer 3

Для поиска вы должны использовать Find, AutoFilter или варианты массива.петли с длинными номерами Nomally слишком медленно, опять же хуже, если они используют 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