vba - 跳过特定列中包含空白单元格的行

Question

请告诉我如何更改我的代码以仅在 BC 列中有值时选择行（如果 BC 列中的单元格为空白，则忽略完整行）：

Private Sub CommandButton3_Click()
    Range("A:a,b:b,c:c,e:e,bc:bc").Select
    Selection.Copy
    Workbooks.Add          
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
End Sub

Answer 1

您可以通过使用过滤器来做到这一点：

1. 通过取消选中（空白）过滤列 BC
2. 复制列
3. 粘贴到新的工作表或工作簿中

如果它必须是 VBA，这里有两个代码可以根据需要执行。第一个代码使用自动过滤器：

Private Sub CommandButton3_Click()

    Dim wsData As Worksheet
    Dim wsNew As Worksheet

    Set wsData = ActiveSheet
    Set wsNew = Sheets.Add

    With Intersect(wsData.UsedRange, wsData.Columns("BC"))
        .Parent.AutoFilterMode = False
        .AutoFilter 1, "<>"
        Intersect(.SpecialCells(xlCellTypeVisible).EntireRow, wsData.Range("A:A,B:B,C:C,E:E,BC:BC")).Copy
        wsNew.Range("A1").PasteSpecial xlPasteValues
        wsNew.Range("A1").PasteSpecial xlPasteFormats
        .AutoFilter
    End With

    wsNew.Move

    Set wsData = Nothing
    Set wsNew = Nothing

End Sub

第二个替代代码使用查找循环：

Private Sub CommandButton3_Click()

    Dim rngFound As Range
    Dim rngCopy As Range
    Dim strFirst As String

    Set rngFound = Columns("BC").Find("*", Cells(Rows.Count, "BC"), xlValues, xlWhole)
    If Not rngFound Is Nothing Then
        strFirst = rngFound.Address
        Set rngCopy = rngFound
        Do
            Set rngCopy = Union(rngCopy, rngFound)
            Set rngFound = Columns("BC").Find("*", rngFound, xlValues, xlWhole)
        Loop While rngFound.Address <> strFirst
    End If

    If Not rngCopy Is Nothing Then
        Sheets.Add
        Intersect(rngCopy.Parent.Range("A:A,B:B,C:C,E:E,BC:BC"), rngCopy.EntireRow).Copy
        Range("A1").PasteSpecial xlPasteValues
        Range("A1").PasteSpecial xlPasteFormats
        ActiveSheet.Move
    End If

    Set rngFound = Nothing
    Set rngCopy = Nothing

End Sub

Answer 2

首先按原样运行您的代码。然后在添加的工作簿中执行行删除：

Sub dural()
    Dim N As Long, I As Long, r As Range
    N = Cells(Rows.Count, "BC").End(xlUp).Row
    For I = N To 1 Step -1
        Set r = Cells(I, "BC")
        If IsEmpty(r) Then
            r.EntireRow.Delete
        End If
    Next
End Sub