Question

我正在尝试使用VBA脚本在选中复选框时触发，该复选框从一个特定单元格复制数据并使用今天的日期粘贴到Month列的最后一个空单元格中。到目前为止，这是我的代码，我已经测试了复选框，触发了复制和粘贴功能。我无法弄清楚的是使用今天的日期找到正确的列并选择该列中的下一个空单元格。我的列在使用长月份名称（文本数据）的第二张纸上标记。

Sub CheckBoxUpdated()
Dim Mnth As String
Dim fndrng
Dim cb As CheckBox


Mnth = MonthName(Month(Date))
With Sheet2 'has to be 'with' something to work correctly
    Set fndrng = Cells.Find(What:=Mnth, After:=A1, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=True)
End With

    On Error Resume Next
    Set cb = ActiveSheet.DrawingObjects(Application.Caller)
    On Error GoTo 0

    If Not cb Is Nothing Then
        If cb.Value = 1 Then
            Sheets("Sheet1").Range(cb.LinkedCell).Offset(0, -4).Copy
            Sheets("Sheet2").Activate
            fndrng.Offset(4, 0).Select
            ActiveSheet.Paste
        End If
    End If

End Sub

非常感谢任何帮助，谢谢!!!!

Answer 1

我立刻注意到了两件事。

在您的第一个With...End With statement中，Set fndrng = Cells.Find ...缺少从With语句分配工作表父级的前缀句点。应为Set fndrng = .Cells.Find...
With Sheet2的结束可以扩展到包含更多代码，让您不再依赖 ActiveSheet 和 Select

考虑这个重写。

Sub CheckBoxUpdated()
    Dim Mnth As String, fndrng as range, cb As CheckBox

    On Error Resume Next

    Mnth = MonthName(Month(Date))

    With Sheet2 'has to be 'with' something to work correctly
        Set fndrng = Cells.Find(What:=Mnth, After:=A1, LookAt:=xlPart, _
                                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                MatchCase:=True)

        Set cb = .DrawingObjects(Application.Caller)
        On Error GoTo 0

        If Not cb Is Nothing Then
            If cb.Value = 1 Then
                Sheets("Sheet1").Range(cb.LinkedCell).Offset(0, -4).Copy _
                    Destination:=fndrng.Offset(4, 0)
            End If
        End If

    End With

End Sub

我改变了你的Copy＆amp; amp;粘贴到更直接的方法，以与With / End With语句的扩展保持一致。

有关远离依赖选择和激活以实现目标的更多方法，请参阅How to avoid using Select in Excel VBA macros。

VBA使用今天的日期和粘贴数据选择月份列中的最后一个空单元格

1 个答案: