☰

Excel 自动新建工作表，其中包含列副本和今天的日期

tag-icon • tag-icon microsoft-excel worksheet-function vba
Excel 自动新建工作表，其中包含列副本和今天的日期

我想编写一个 VBA 例程，可以“每天”

  • 创建新工作表
  • 给新工作表命名为日月年（带前导零），基于今天的日期（例如，25.07.18）
  • 将工作表 A 和 B 列的值复制DataInput到新工作表中。

我所说的“每日”是什么意思？如果当前时间 = 或 > 一天中的指定时间，则创建工作表，否则忽略。

我觉得这并不难。我尝试组合一些公式来将它们放在一起，但它们总是出错。

我在想一些事

Option Explicit
Sub ReportSheet_Today()
    Dim szTodayDate As String

    szTodayDate = Format(Date, "dd.mm.yy")
    On Error GoTo MakeSheet
    Sheets(szTodayDate).Activate
    If Time < TimeValue("9:00:00") Then
        'MakeSheet:
        Sheets.Add , Worksheets(Worksheets.Count)
        ActiveSheet.Name = szTodayDate
        Sheets("DataInput").Select
        Range("A:A").Copy
        Sheets("szTodayDate").Select
        Range("A:A").Select
        ActiveSheet.Paste
    End IF
End Sub

答案1

错误在这里：

Sheets("szTodayDate").Select

szTodayDate不是工作表的名称；它是一个局部变量，包含表示工作表名称的字符串……但你使用它作为字符串字面量，因此 VBA 尝试取消引用工作表对象字面上地名为“szTodayDate”...并且由于找不到它，因此出现运行时错误 9。

删除双引号：

Sheets(szTodayDate).Select

现在你将取消引用以的价值字符串szTodayDate变量，这可能就是您想要的。

下一步...

将创建工作表的逻辑放入其自己的单独程序中；编写小型的专门程序，专做一件事并做好它，将使您的生活变得更加轻松。

您可以利用函数的返回值：Worksheets.Add返回对已创建的工作表对象的引用 - 通过将该引用捕获到本地对象变量中，您无需对它进行操作Select，然后就可以继续工作ActiveSheet。

您还可以提供目的地参数Range.Copy，使得整个选择-复制-选择-粘贴操作一行。

Public Function CreateReportSheet(ByVal reportDate As Date) As Worksheet

    Dim reportSheet As Worksheet
    Set reportSheet = AddNamedWorksheet(ThisWorkbook, Format$(reportDate, "dd.mm.yy"))

    'only needed if the sheet doesn't exist at compile-time.
    'if it *does* exist at compile-time, just set the sheet's (Name) property to "inputSheet".
    'that identifier will then be globally available anywhere in the project.
    'Dim inputSheet As Worksheet
    'Set inputSheet = ThisWorkbook.Worksheets("DataInput")

    inputSheet.Range("A:A").Copy reportSheet.Range("A:A")
    Set CreateReportSheet = reportSheet

End Function

Public Function AddNamedWorksheet(ByVal wb As Workbook, ByVal sheetName As String) As Worksheet
    Dim sheet As Worksheet
    Set sheet = wb.Worksheets.Add
    On Error Resume Next ' naming the sheet will throw if name already exists
        sheet.Name = sheetName
    On Error GoTo 0 ' restore error handling
    Set AddNamedWorksheet = sheet
End Function

相关内容