根据现有工作表中的日期创建新工作表...列

Question

所以我有一个带有日期列的主表。 主表中的数据具有重复的日期。 意思是说，对于我们每月要谈的事情，我可以得到2010年7月1日多达100倍，或少至2倍。

我想要做的是在日期列中进行筛选，并根据该列中的日期（天）创建新的表格，但是我只想要唯一的值。

因此，我有多个在VBA中创建新工作表的示例，这不是我的问题。 它正在生成唯一列表以创建工作表，这正是我遇到的问题。

Sub Add_Sheets()
Dim WS As Worksheet
Set WS = sheets.Add(After:=Worksheets("MasterSheet"))
WS.Name = 1  '<-- Want to call something so as to get the day from Master dynamically'
End Sub

这使我获得了唯一的日期，但没有日期列表：

Sub UniqueList()
Dim lastrow As Long
Dim sheets As Worksheet
Set sheets = ThisWorkbook.Worksheets("MasterSheet")
lastrow = sheets.Cells(Rows.Count, 3).End(xlUp).Row
sheets.Range("C2:C" & lastrow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=sheets.Range("G2"), Unique:=True 'dont prefer this but it works.
End Sub

所以我愿意提出建议。 最近启动了该项目，因此请尽快重做所有项目。 需要是VBA，因此用户只需单击按钮即可。

感谢您的指导。

Answer 1

Function getSheetByName(sh As String) As Worksheet
    On Error Resume Next
    Set getSheetByName = Worksheets(sh)
    If Err.Number <> 0 Then Set getSheetByName = Nothing
End Function

Sub CreateSheetsByUniqueDate()
   Dim cell As Range, name As String
   Application.DisplayAlerts = False

   For Each cell In Worksheets("MasterSheet").UsedRange.Columns(3).Cells ' <~~ set to your date column
       name = "WS_" & Format(cell.Text, "dd")
       If getSheetByName(name) Is Nothing Then Worksheets.Add().name = name
   Next
   Application.DisplayAlerts = True
End Sub