excel - 复制一系列单元格并仅选择包含数据的单元格

Question

我正在寻找一种复制一系列单元格的方法，但仅复制包含值的单元格。

在我的 Excel 工作表中，我有从 A1-A18 运行的数据，B 为空，C1-C2。现在我想复制所有包含值的单元格。

 With Range("A1")
     Range(.Cells(1, 1), .End(xlDown).Cells(50, 3)).Copy
 End With

这将复制 A1-C50 中的所有内容，但我只想复制 A1-A18 和 C1-C2，就像它们包含数据一样。但它需要以一种方式形成，一旦我在 B 中有数据或我的范围扩展，这些也会被复制。

'So the range could be 5000 and it only selects the data with a value.
With Range("A1")
Range(.Cells(1, 1), .End(xlDown).Cells(5000, 3)).Copy
End With

谢谢!

<小时/>

感谢 Jean，当前代码:

Sub test()

Dim i As Integer
Sheets("Sheet1").Select
i = 1

With Range("A1")
   If .Cells(1, 1).Value = "" Then
   Else
     Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("A" & i)
     x = x + 1
   End If
End With

Sheets("Sheet1").Select

x = 1
With Range("B1")
' Column B may be empty. If so, xlDown will return cell C65536
' and whole empty column will be copied... prevent this.
    If .Cells(1, 1).Value = "" Then
       'Nothing in this column.
       'Do nothing.
    Else
       Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("B" & i)
       x = x + 1
    End If
End With

Sheets("Sheet1").Select

x = 1
With Range("C1")
    If .Cells(1, 1).Value = "" Then
    Else
        Range(.Cells(1, 1), .End(xlDown)).Copy Destination:=Sheets("Sheet2").Range("C" & i)
        x = x + 1
    End If
End With

End Sub

A1 - A5 包含数据，A6 为空白，A7 包含数据。它停在 A6 处，前往 B 列，然后以同样的方式继续行驶。

Answer 1

由于您的三列大小不同，因此最安全的做法是将它们一一复制。任何 PasteSpecial 的快捷方式最终都可能会让您头疼。

With Range("A1")
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeA
End With

With Range("B1")
    ' Column B may be empty. If so, xlDown will return cell C65536
    ' and whole empty column will be copied... prevent this.
    If .Cells(1, 1).Value = "" Then
        'Nothing in this column.
        'Do nothing.
    Else
        Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeB
    EndIf
End With

With Range("C1")
    Range(.Cells(1, 1), .End(xlDown)).Copy myDestinationRangeC
End With

现在这很丑陋，一个更干净的选择是循环遍历列，特别是如果您有很多列并且您以相同的顺序将它们粘贴到相邻列。

Sub CopyStuff()

    Dim iCol As Long

    ' Loop through columns
    For iCol = 1 To 3 ' or however many columns you have
        With Worksheets("Sheet1").Columns(iCol)
            ' Check that column is not empty.
            If .Cells(1, 1).Value = "" Then
                'Nothing in this column.
                'Do nothing.
            Else
                ' Copy the column to the destination
                Range(.Cells(1, 1), .End(xlDown)).Copy _
                    Destination:=Worksheets("Sheet2").Columns(iCol).Cells(1, 1)
            End If
        End With
    Next iCol

End Sub

<小时/>

编辑所以你改变了你的问题...尝试循环遍历各个单元格，检查当前单元格是否为空，如果不是则复制它。还没有测试过，但你明白了:

    iMaxRow = 5000 ' or whatever the max is. 
    'Don't make too large because this will slow down your code.

    ' Loop through columns and rows
    For iCol = 1 To 3 ' or however many columns you have
        For iRow = 1 To iMaxRow 

        With Worksheets("Sheet1").Cells(iRow,iCol)
            ' Check that cell is not empty.
            If .Value = "" Then
                'Nothing in this cell.
                'Do nothing.
            Else
                ' Copy the cell to the destination
                .Copy Destination:=Worksheets("Sheet2").cells(iRow,iCol)
            End If
        End With

        Next iRow
    Next iCol

如果iMaxRow很大，这段代码将会非常慢。我的直觉是，您正试图以一种低效的方式解决问题...当问题不断变化时，很难确定最佳策略。