如果单元格为空，粘贴，否则，转到下一个空白单元格并粘贴

Question

基本上我只需要excel来验证单元格A1是否为空。

如果 A1 为空，则从 A1 开始粘贴。 如果 A1 不为空，则转到 A 列中的下一个空白单元格，然后粘贴到那里。

我收到一个错误：代码的 Else 部分出现应用程序定义或对象定义错误。

If IsEmpty("A1") Then
    Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Else
    Range("A1").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End If

Answer 1

我注意到两个问题。 (1) 在第一行代码中，您正在测试文本“A1”是否为空，而不是单元格 A1。所以首先改变它，以便 IsEmpty 测试单元格 A1。 (2) 当您在 A1 下方添加条目时，您需要一些方法来计算粘贴前要向下移动的行数。现在，您的代码从单元格 A1 开始并偏移 1。这只会工作一次。下面的示例计算 A 列中填充了多少行，然后偏移 1 行。

If IsEmpty(Range("A1")) Then
    Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Else
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End If

Answer 2

粘贴到列中的下一个可用单元格

问题

• 查看您的代码并想象单元格A1 不是空的，但A 列中的其余单元格是空的。然后Range("A1").End(xlDown) 将“跳转”到A 列的最底部单元格：A1048576。您还尝试执行 .Offset(1) 这是不可能的，因此出现错误。
• 现在，再次查看您的代码并想象A1:A5 的范围不是空的，但单元格A6 是。然后Range("A1").End(xlDown).Offset(1, 0) 将“跳转”到单元格A6。但想象一下单元格A7 也不是空的。然后你可能会覆盖单元格A7中的值。

引入函数（快速修复）

• 你可以这样做：

  Dim dCell As Range: Set dCell = RefFirstAvailableCell(Range("A1"))
  dCell.PasteSpecial Paste:=xlPasteValues ' the rest were default values
  Application.CutCopyMode = False
  

  它使用以下函数：

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Creates a reference to the First Available Cell in a column,
'               i.e. creates a reference to the cell
'               below the Last Non-Empty Cell in the Column Range
'               spanning from the First Cell of a range ('rg')
'               to the Bottom-Most Cell of the worksheet column.
' Remarks:      If all cells in the Column Range are empty,
'               it creates a reference to the First Cell.
'               If the Bottom-Most Cell of the worksheet column
'               is not empty, it returns 'Nothing'.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RefFirstAvailableCell( _
    ByVal rg As Range) _
As Range
    If rg Is Nothing Then Exit Function
    
    With rg.Cells(1)
        Dim wsrCount As Long: wsrCount = .Worksheet.Rows.Count
        Dim fRow As Long: fRow = .Row
        Dim lCell As Range
        Set lCell = .Resize(wsrCount - fRow + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then
            Set RefFirstAvailableCell = .Offset
        Else
            Dim lRow As Long: lRow = lCell.Row
            If lRow = wsrCount Then
                Exit Function
            Else
                Set RefFirstAvailableCell = .Offset(lRow - fRow + 1)
            End If
        End If
    End With
    
End Function

测试功能

• 函数使用Range.Find method代替End statement，更可靠。事实上，它“通常”（认为合并的单元格或类似的）只有在工作表被过滤时才会失败。
• 以下过程说明了如何通过赋值进行复制，这在仅复制值时比PasteSpecial 更“干净”且更高效（更快）。它还引入了一些额外的故障保护（验证...）。
• 要使用它，请将这两个代码复制到新工作簿的标准模块（例如Module1），并确保它包含Sheet1 和Sheet2（代码名称）。运行该过程并查看两个工作表中发生了什么。重复几次步骤，观察Sheet1 的变化。通过更改此过程代码（而不是函数）中的各种常量值来玩弄它。

Sub RefFirstAvailableCellTEST()
    ' Create a reference to the Source Range.
    Dim srg As Range: Set srg = Sheet2.Range("B2:D5")
    ' Populate the Source Range.
    Dim sCell As Range
    Dim n As Long
    For Each sCell In srg.Areas(1).Cells
        n = n + 1
        sCell.Value = n
    Next sCell
    ' Write the number of source rows and columns to variables.
    Dim rCount As Long: rCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    ' Create a reference to the Destination Initial First Cell.
    Dim diCell As Range: Set diCell = Sheet1.Range("A2")
    ' Create a reference to the Destination First Available Cell.
    Dim dCell As Range: Set dCell = RefFirstAvailableCell(diCell)
    ' Validate First Available Cell.
    If dCell Is Nothing Then Exit Sub
    If dCell.Row > Sheet1.Rows.Count - rCount + 1 Then Exit Sub
    If dCell.Column > Sheet1.Columns.Count - cCount + 1 Then Exit Sub
    ' Create a reference to the Destination Range.
    Dim drg As Range: Set drg = dCell.Resize(rCount, cCount)
    ' Write the values from the Source Range to the Destination Range.
    drg.Value = srg.Value
End Sub