Excel VBA：如何將文本添加到特定列中的空白單元格，然后循環到下一個空白單元格並添加文本？

Question

我需要一個宏來向 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

Answer 1

要查找最后一行數據，請使用End(xlUp)函數。

試試這個代碼。 它將 A 列中的所有空單元格替換為Administration 。

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

Answer 2

沒有必要循環。 請試試這個代碼。

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" & vbCr & _
               "in the specified range.", _
               vbInformation, "Range " & Rng.Address(0, 0)
    Else
        Rng.Value = "Administration"
    End If
End Sub

Answer 3

替換空白專長。 當前區域

范圍.當前區域

• 由於 OP 要求“...在數據集末尾停止循環。” ，我編寫了這個CurrentRegion版本。
• 據我了解，數據集的末尾並不意味着在A列中包含數據的最后一個單元格下方不能有空白單元格。
• 使用第一個 Sub 來測試第二個，主要的 Sub ( replaceBlanks )。
• 調整包括工作簿在內的常量（在第一個子文件中）以滿足您的需要。
• 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 '" & Criteria & "' to " & k & " previously " _
         & "empty cell(s) in range '" & ColumnRange.Address & "'.", _
           vbInformation, "Success"
    Return
Fail:
    MsgBox "No empty cells in range '" & ColumnRange.Address & "'.", _
           vbExclamation, "Nothing Written"
    Return
           
End Sub