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

测试功能

该函数使用更可靠的 End statement 代替 Range.Find method。事实上，它“通常”（想想合并的单元格或类似的）只有在工作表被过滤时才会失败。
以下过程说明了如何通过赋值进行复制，这在仅复制值时比 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

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

2 个答案:

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