为多行重复代码

时间:2018-07-24 15:01:43

标签: excel vba loops repeat

我下面有VBA代码,非常适合一行。我需要此循环100行并为每一行做相同的工作。有人可以帮我吗?

Sub IsEmptyRange()

Dim cell As Range

Dim bIsEmpty As Boolean

bIsEmpty = False

For Each cell In Range("A1:H1")

    If IsEmpty(cell) = True Then

        bIsEmpty = True

        Exit For

    End If

Next cell

If bIsEmpty = True Then

    '**PLACE CODE HERE**

    [I1].Value = "Empty Cells"

Else

    '**PLACE CODE HERE**

    [I1].Value = "Complete"

End If

End Sub

谢谢!

2 个答案:

答案 0 :(得分:0)

您可以尝试实现吗?

* = things added/changed (remove when you put in VBA)

*Dim lRow as Integer
*Dim i as Integer

*lRow = Cells(Rows.Count, 1).End(xlUp).Row

*For i = 1 to lRow
For Each cell In Range("A" & i & ":H" & i)

If IsEmpty(cell) = True Then

    bIsEmpty = True

    Exit For

End If

Next cell

If bIsEmpty = True Then

'**PLACE CODE HERE**

*[I & i].Value = "Empty Cells"

Else

'**PLACE CODE HERE**

*[I & i].Value = "Complete"

End If
*Next i

答案 1 :(得分:0)

这根本不需要是VBA吗?看来您可以在单元格i1中使用此公式并复制下来:=IF(COUNTBLANK(A1:H1)>0,"Empty Cells","Complete")

如果绝对必须是VBA,那么它将为您工作:

Sub tgr()

    Dim ws As Worksheet
    Dim lLastRow As Long

    Set ws = ActiveWorkbook.ActiveSheet
    On Error Resume Next
    lLastRow = ws.Range("A:H").Find("*", ws.Range("A1"), xlValues, xlPart, , xlPrevious).Row
    On Error GoTo 0
    If lLastRow = 0 Then Exit Sub   'No data

    With ws.Range("I1:I" & lLastRow)
        .Formula = "=IF(COUNTBLANK(A" & .Row & ":H" & .Row & ")>0,""Empty Cells"",""Complete"")"
        .Value = .Value
    End With

End Sub