excel - VBA循环结合Lastrow并查找空白值

Question

我正在尝试构建一个“数据检查”类型的文件，其中一系列宏查看数据集并根据各种标准将不正确的条目复制/粘贴到单独的工作表中。其中之一是查看 A 列中的值是否为空白。

以下是我目前拥有的代码。它只需要第一个空白实例，我正在尝试让它循环查找 A 列中的所有空白值。

Sub copy_blanks()  
    Dim sr As Range
    Dim blank As Long
    Dim i As Integer
    Dim s1 As Worksheet
    Dim s2 As Worksheet

    Set s1 = Worksheets("data")
    Set s2 = Worksheets("No LoadID")

    lr2 = s2.Cells(Rows.Count, 2).End(xlUp).Row

    Set sr = Worksheets("data").Range("A:A").Find("")

    If Not sr Is Nothing Then  
        blank = sr.Row
        s1.Rows(blank).Copy
        s2.Cells(lr2 + 1, 1).PasteSpecial xlPasteValues
    End If
End Sub

Answer 1

看看Range.SpecialCells Method .
您可以使用 SpecialCells(xlCellTypeBlanks)查找范围内的所有空白单元格。

Dim wsData As Worksheet
Set wsData = Worksheets("data")

Dim LastDataRow As Range
Set LastDataRow = wsData.Cells(Rows.Count, "A").End(xlUp) 'last used cell in column A

Dim wsNoID As Worksheet
Set wsNoID = Worksheets("No LoadID")

Dim BlankCells As Range
On Error Resume Next 'next line will throw an error if no blanks are found
Set BlankCells = wsData.Range("A1", LastDataRow).SpecialCells(xlCellTypeBlanks) 'find all blank cells in column A until last data row
On Error Goto 0 're-activate error messages!

If Not BlankCells Is Nothing Then
    BlankCells.EntireRow.Copy

    wsNoID.Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).PasteSpecial xlPasteValues
Else
    MsgBox "No blanks found."
End If