Блог

Мне нужен макрос для добавления текста в пустые ячейки в столбце A. Макрос должен пропускать ячейки, содержащие текст. Макрос должен прекратить цикл в конце набора данных.

Я пытаюсь использовать оператор If Else, но мне кажется, я на неверном пути. Мой текущий нерабочий код приведен ниже. Большое вам спасибо — я все еще новичок в VBA

 Sub ElseIfi()

For i = 2 To 100

If Worksheets("RawPayrollDump").Cells(2, 1).Value = "" Then
Worksheets("RawPayrollDump").Cells(2, 1).Value = "Administration"

Else if(not(worksheets("RawPayrollDump").cells(2,1).value="")) then 'go to next cell

End If

Next

    
End Sub
  

Чтобы найти последнюю строку данных, используйте End(xlUp) функцию.

Попробуйте этот код. Он заменяет все пустые ячейки в столбце A на Администрирование.

 Sub ElseIfi()
    Set ws = Worksheets("RawPayrollDump")
    
    lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' last data row
        
    For i = 2 To lastrow  ' all rows until last data row
        If ws.Cells(i, 1).Value = "" Then  ' column A, check if blank
           ws.Cells(i, 1).Value = "Administration"  ' set text
        End If
    Next
End Sub
  

Нет необходимости в цикле. Пожалуйста, попробуйте этот код.

 Sub FillBlanks()

    Dim Rng         As Range
    
    With Worksheets("RawPayrollDump")
        Set Rng = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    End With
    On Error Resume Next
    Set Rng = Rng.SpecialCells(xlCellTypeBlanks)
    If Err Then
        MsgBox "There are no blank cells" amp; vbCr amp; _
               "in the specified range.", _
               vbInformation, "Range " amp; Rng.Address(0, 0)
    Else
        Rng.Value = "Administration"
    End If
End Sub
  

Заменить пробелы подвиг. CurrentRegion

Диапазон.CurrentRegion

• Поскольку OP запросил «… прекратить цикл в конце набора данных»., я написал эту CurrentRegion версию.
• Насколько я понимаю, конец набора данных не означает, что под последней ячейкой, содержащей данные в столбце, не может быть пустых ячеек A .
• Используйте 1-й подраздел для проверки 2-го, основного подраздела ( replaceBlanks ).
• Настройте постоянныепараметры, включая рабочую книгу (в 1-м подразделе), в соответствии с вашими потребностями.
• Criteria объявлен как Variant, чтобы разрешить использование других типов данных, а не только строк.

Код

 Option Explicit

Sub testReplaceBlanks()
    
    Const wsName As String = "RawPayrollDump"
    Const FirstCellAddress As String = "A2"
    Const Criteria As Variant = "Administration"
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    replaceBlanks ws, FirstCellAddress, Criteria
    
End Sub

Sub replaceBlanks(Sheet As Worksheet, _
                  FirstCellAddress As String, _
                  Criteria As Variant)
    
' Define column range.
    
    Dim ColumnRange As Range
    Set ColumnRange = Intersect(Sheet.Range(FirstCellAddress).CurrentRegion, _
                                Sheet.Columns(Sheet.Range(FirstCellAddress) _
                                                   .Column))
    ' To remove the possibly included cells above the first cell:
    Set ColumnRange = Sheet.Range(Range(FirstCellAddress), _
                                  ColumnRange.Cells(ColumnRange.Cells.Count))
    ' Note that you can also use the addresses instead of the cell range
    ' objects in the previous line...
    'Set ColumnRange = sheet.Range(FirstCellAddress, _
                                  ColumnRange.Cells(ColumnRange.Cells.Count) _
                                             .Address)
    ' or a mixture of them.
    
' Write values from column range to array.
    
    Dim Data As Variant
    If ColumnRange.Cells.Count > 1 Then
        Data = ColumnRange.Value
    Else
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = ColumnRange.Value
    End If

' Modify array.
    
    Dim i As Long, k As Long
    For i = 1 To UBound(Data)
        If IsEmpty(Data(i, 1)) Then Data(i, 1) = Criteria: k = k   1
    Next i
    
' Write modified array to column range.
    
    ' The following line is used when only the first cell is known...
    'Sheet.Range(FirstCellAddress).Resize(UBound(Data)).Value = Data
    ' ...but since the range is known and is the same size as the array,
    ' the following will do:
    ColumnRange.Value = Data
    
' Inform user.
    
    If k > 0 Then GoSub Success Else GoSub Fail
    
    Exit Sub
    
' Subroutines

Success:
    MsgBox "Wrote '" amp; Criteria amp; "' to " amp; k amp; " previously " _
         amp; "empty cell(s) in range '" amp; ColumnRange.Address amp; "'.", _
           vbInformation, "Success"
    Return
Fail:
    MsgBox "No empty cells in range '" amp; ColumnRange.Address amp; "'.", _
           vbExclamation, "Nothing Written"
    Return
           
End Sub