Простая петля, повторяющаяся над строкой ActiveCell в VBA

Question

Я пишу довольно простой макрос в VBA, и я впервые пишу что-нибудь в нем, поэтому я много борюсь. Я полностью знаю логику того, что мне нужно сделать, я просто не получаю синтаксис VBA. Я хочу перебирать каждую ячейку в строке, если первая ячейка в этой строке содержит определенную подстроку. Внутри цикла for, я хочу добавить эту подстроку в конец каждой ячейки в строке, если эта ячейка не пуста. Я не получаю мимо моего для цикла декларации

Sub changeRow() 
Dim txt As String 
txt = Cells(ActiveCell.Row, 1) 
    If InStr(1, txt, "123") > 0 Then 
    For Each b In Range(Rows(ActiveCell.Row).Select) 
     If Len(b.Value) > 0 Then 
      b.Value = b.Value & " 123" 
     End If 
    Next b 
End If  
End Sub 

Answer 1

Один из способов

Sub changeRow() 
    Const sTxt  As String = "123" 
    Dim cell   As Range 

    With Cells(ActiveCell.Row, "A") 
    If VarType(.Value) = vbString Then 
     If InStr(.Value, sTxt) Then 
     For Each cell In .EntireRow.SpecialCells(xlCellTypeConstants, xlTextValues) 
      cell.Value = cell.Value & " " & sTxt 
     Next cell 
     End If 
    End If 
    End With 
End Sub 

Это будет также добавить «123» в ячейку, в которой он находится, но не клеток, содержащих числа или формулы.

EDIT: В приведенном выше кодексе есть ошибка. Он должен проверить, что клетка в Col А не содержит формулу:

Sub changeRow() 
    Const sTxt  As String = "123" 
    Dim cell   As Range 

    With Cells(ActiveCell.Row, "A") 
    If VarType(.Value) = vbString And Not .HasFormula Then 
     If InStr(.Value, sTxt) Then 
     For Each cell In .EntireRow.SpecialCells(xlCellTypeConstants, xlTextValues) 
      cell.Value = cell.Value & " " & sTxt 
     Next cell 
     End If 
    End If 
    End With 
End Sub 

В противном случае линия SpecialCells может генерировать сообщение об ошибке выполнения.

Answer 2

Это делает то, что вы хотите без введения каких-либо новых переменных (хотя я изменить неинформативное «Ъ» в cell:

Sub changeRow() 
Dim txt As String 
Dim cell As Excel.Range 

txt = ActiveCell.EntireRow.Cells(1) 
If InStr(1, txt, "123") > 0 Then 
    For Each cell In Intersect(ActiveCell.EntireRow, ActiveCell.Parent.UsedRange) 
     If Len(cell.Value) > 0 Then 
      cell.Value = cell.Value & " 123" 
     End If 
    Next cell 
End If 
End Sub 

Он также не оставляет каких-либо неквалифицированных диапазонов переменных, что является хорошей идеей. Обычно вы избегаете этого, вводя переменную типа ws, чтобы ссылаться на лист, с которым вы имеете дело. Но этот код прост и основан на Activecell, поэтому я просто использовано Activecell.Parent.

Answer 3

Я вижу, что вы нашли решение. Я просто придерживаюсь того факта, что «вы новичок в VBA». Если у вас есть сомнения, не стесняйтесь комментировать. Сохраняя большую часть оригинальной логики в месте,

'-- this line is very important, it keeps "in order" to write code 
'-- Forces explicit declaration of all variables in a file, or allows implicit declarations of variables. 
'-- please explore on that 
Option Explicit 

'-- writing this with more comments since you said you are new to VBA 
Sub changeRow() 
Dim ws As Worksheet 
Dim b As Range 
Dim activeRange As Range 
Dim fullRange As Range 
Dim lastColumn As Long 
Dim txt As String 

    '-- set current sheet into a reference object variable called WS 
    Set ws = ActiveWorkbook.Sheets("Sheet1") 
    '-- similarly the range you plan to start the validation 
    Set activeRange = ws.Range("B2") 
    txt = activeRange.Value2 

    '-- get last column in the row, 2 refers to rows 2 where you have data 
    lastColumn = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column 
    '-- get range until the last column in the row 
    Set fullRange = Sheets("Sheet1").Range("B2").Resize(, lastColumn) 

    '-- this allows you to view the Address of this range in the Immediate Window, just to make sure you get the desired range right 
    Debug.Print fullRange.Address 

    If InStr(1, txt, "123") > 0 Then 
     '-- iterating through each range in full range that we specified above 
     For Each b In fullRange 
      '-- there's no need to check this because when InStr() fails, 
      '-- the compiler will not come to this validation! 
      If Len(b.Value) > 0 Then 
       '-- b.Offset(3) refers to 3 rows down from cell B2 which is B5 
       '-- output into 5th row for demonstration purpose 
       '-- you may set it back to b.Value per your requirement. 
       '-- Please explore offset property of Range object 
       b.Offset(3).Value = b.Value & " 123" 
      End If 
     Next b 
    End If 

    '-- release the memory allocated to these reference object variables 
    '-- the order is: first ranges, then worksheet 
    Set activeRange = Nothing 
    Set fullRange = Nothing 
    Set ws = Nothing 

End Sub