Excel VBA: come si aggiunge testo a una cella vuota in una colonna specifica, quindi si passa alla cella vuota successiva e si aggiunge testo?

Question

Ho bisogno di una macro per aggiungere testo alle celle vuote nella colonna A. La macro deve saltare le celle che contengono testo. La macro deve interrompere il ciclo alla fine del set di dati.

Sto cercando di utilizzare un'istruzione If Else, ma penso di essere sulla strada sbagliata. Il mio attuale codice non funzionante è di seguito. Grazie mille, sono ancora nuovo in 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

Per trovare l'ultima riga di dati, utilizza la End(xlUp)funzione.

Prova questo codice. Sostituisce tutte le celle vuote nella colonna A con Amministrazione .

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

Non è necessario eseguire il loop. Prova questo codice.

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

Sostituisci Blanks feat. CurrentRegion

Range.CurrentRegion

• Poiché OP ha chiesto "... interrompi il ciclo alla fine del set di dati." , Ho scritto questa CurrentRegionversione.
• A quanto ho capito, la fine del set di dati non significa che non possano esserci celle vuote sotto l'ultima cella contenente i dati nella colonna A.
• Usa il primo Sub per testare il secondo, il Sub principale ( replaceBlanks).
• Regola le costanti, inclusa la cartella di lavoro (nella prima sottosezione), in base alle tue esigenze.
• Criteria è dichiarato come Variant per consentire altri tipi di dati non solo stringhe.

Il codice

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)
    Call 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