创建报告模板表并根据日期和时间填充数据

Question

我有一张原始数据表，其中包括多天的车辆数量。每个日期都是一行，表示在 60 分钟内的车辆计数（因此每天 24 行）。 我有一个模型，它每天使用报告模板创建一个新工作表。我只是不知道如何获取每天的实际车辆计数数据来填充每小时的每张表。 创建的每个新选项卡都以日期命名。如果我们有 8 天的车辆计数，则将创建 8 个新选项卡。在该新选项卡中，我需要能够获取所有 24 辆汽车的数量并将它们粘贴到相应单元格中的模板报告中。

Option Explicit

Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shDates As Range, Item As Range, NmStr As String

'keep focus in this workbook
With ThisWorkbook
     'sheet to be copied                           
    Set wsTEMP = .Sheets("Template")             
    'check if it's hidden or not    
     wasVISIBLE = (wsTEMP.Visible = xlSheetVisible) 
    'make it visible           
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      

    'sheet with dates and data
    Set wsMASTER = .Sheets("Raw Data")             

    'range to find names to be checked
    Set shDates = wsMASTER.Range("C9:C" & Rows.Count).SpecialCells(xlConstants)   

    Application.ScreenUpdating = False
    'check one data at a time                 
    For Each Item In shDates                        
        NmStr = FixStringForSheetName(CStr(Item.Text))
        'if sheet does not exist...
        If Not Evaluate("ISREF('" & NmStr & "'!A1)") Then
            '...create it from template  
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)  
            '...rename it 
            ActiveSheet.Name = NmStr                        
        End If

    Next Item

    'return to the master sheet
    wsMASTER.Activate  
    'hide the template if necessary                                         
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden   
    'update screen one time at the end   
    Application.ScreenUpdating = True                           

End With


MsgBox "All Reports created"

Answer 1

如果没有看到您的工作表（数据的布局/位置）就很难回答，但类似下面的内容可能会让您了解如何实现您所追求的目标。

Option Explicit

Sub SheetsFromTemplate()

    Dim templateSheet As Worksheet
    Set templateSheet = ThisWorkbook.Worksheets("Template")

    Dim originalSheetState As XlSheetVisibility
    originalSheetState = templateSheet.Visible

    'sheet with dates and data
    Dim masterSheet As Worksheet
    Set masterSheet = ThisWorkbook.Worksheets("Raw Data")

    templateSheet.Visible = xlSheetVisible

    Dim lastRowOnMasterSheet As Long
    lastRowOnMasterSheet = masterSheet.Cells(masterSheet.Rows.Count, "C").End(xlUp).Row
    Debug.Assert lastRowOnMasterSheet >= 9

    'range to find names to be checked
    Dim datesToLoopThrough As Range
    Set datesToLoopThrough = masterSheet.Range("C9:C" & lastRowOnMasterSheet)

    Dim toFilterIncludingHeaders As Range
    Set toFilterIncludingHeaders = datesToLoopThrough.Offset(-1).Resize(datesToLoopThrough.Rows.Count + 1)

    Application.ScreenUpdating = False
    'check one data at a time
    Dim item As Range
    For Each item In datesToLoopThrough

        Dim nmStr As String
        nmStr = FixStringForSheetName(CStr(item.Text))

        ' The IF condition below might be problematic if sheet
        ' already exists, but has not yet had dates
        ' transferred/copy-pasted to it.
        If Not DoesWorksheetExist(nmStr) Then
            With CreateSheetFromTemplate(templateSheet)
                .Name = nmStr
                .Move After:=.Parent.Worksheets(.Parent.Worksheets.Count)

                toFilterIncludingHeaders.AutoFilter Field:=1, Criteria1:=item
                Intersect(datesToLoopThrough.SpecialCells(xlCellTypeVisible).EntireRow, mastersheet.range("D:Q")).Copy .Range("F13") ' You haven't shown your template sheet, so don't know where to paste to.
            End With
        End If
    Next item

    masterSheet.Activate
    templateSheet.Visible = originalSheetState

    'update screen one time at the end
    Application.ScreenUpdating = True

    MsgBox "All Reports created"
End Sub

Private Function CreateSheetFromTemplate(ByVal someTemplateSheet As Worksheet) As Worksheet
    ' Creates a copy of template sheet and returns an object reference to the newly created sheet.
    ' Newly created sheet is at index 1 (for deterministic/reliability reasons).
    ' Call site can name/move as needed.
    someTemplateSheet.Copy Before:=someTemplateSheet.Parent.Worksheets(1)
    Set CreateSheetFromTemplate = someTemplateSheet.Parent.Worksheets(1)
End Function

Private Function DoesWorksheetExist(ByVal sheetNameToCheck As String) As Boolean
    ' Checks if sheet of a given name exists in ThisWorkbook.
    Dim targetSheet As Worksheet
    On Error Resume Next
    Set targetSheet = ThisWorkbook.Worksheets(sheetNameToCheck)
    On Error GoTo 0
    DoesWorksheetExist = Not (targetSheet Is Nothing)
End Function