Question

我使用按钮宏来复制范围，这非常简单：

Worksheets("SNOW").Range("C6:D18").Copy

现在，我如何修改它以说＆＃34;复制此范围，但如果D列中的值为空，则在复制过程中完全跳过该行＆＃34;？处理文本而不是数字。

感谢。

Answer 1

您必须使用Union创建仅包含选定行的范围（如果D列中的值不为空白）：

Sub Test()

Dim rng As Range, i As Long

For i = 6 To 18
    If Range("D" & i).Value <> "" Then
        If rng Is Nothing Then
            Set rng = Range("C" & i & ":D" & i)
        Else
            Set rng = Application.Union(rng, Range("C" & i & ":D" & i))
        End If
    End If
Next i

If Not rng Is Nothing Then
    rng.Copy
End If

End Sub

Answer 2

您可以过滤和复制过滤后的数据：

Sub Copy_Filtered()

    With ThisWorkbook.Worksheets("Snow")
        If .FilterMode Then
            .ShowAllData
        End If

        With .Range("A6:D18")
            .AutoFilter Field:=4, Criteria1:="<>"
            .Copy 'Destination:=ThisWorkbook.Worksheets("Blizzard").Range("A1")
        End With

    End With

End Sub

注意：取消注释目标以将范围粘贴到暴雪表。

Answer 3

您可以单独复制每个区域。

Option Explicit
Sub foo()
    Dim ws As Worksheet, r As Range, rCpy As Range
    Dim rDest As Range

Set ws = Worksheets("SNOW")
With ws
    Set r = .Range(.Cells(6, 4), .Cells(18, 4)).SpecialCells(xlCellTypeConstants)
    Set rDest = .Cells(6, 10)

    For Each rCpy In r.Areas
        Set rCpy = rCpy.Offset(columnoffset:=-1).Resize(columnsize:=2)
        rCpy.Copy rDest
        Set rDest = rDest.Offset(rCpy.Rows.Count)
    Next rCpy
End With

End Sub

另一种方法，无论源数据的内容是什么都可以使用：

Set ws = Worksheets("SNOW")
With ws
    .Rows.Hidden = False
    Set rDest = .Cells(1, 6)
    Set r = .Range(.Cells(6, 4), .Cells(18, 4)).SpecialCells(xlCellTypeBlanks)
    r.EntireRow.Hidden = True
    Set r = .Range(.Cells(6, 3), .Cells(18, 4)).SpecialCells(xlCellTypeVisible)
    .Rows.Hidden = False
    r.Copy rDest
End With

如何复制范围，忽略第2列中的值为空的行

3 个答案: