检查是否存在多个特定的工作表,然后添加缺失的工作表

时间:2019-06-05 10:51:02

标签: excel vba

我是一个初学者,正在努力开发一般编程所需的逻辑。希望有人可以帮助我!

我正在设置一个包含两张纸的简单工作簿。一张纸用于数据集,第二张纸用于分析。首先是数据集表(在左侧/ Sheet1),然后是分析表,其次是在右侧(Sheet2)。每个工作表名称都会有今天的日期和标题。

我希望脚本检查今天的日期是否都存在。如果是这样,则无需采取任何措施。如果缺少工作表1,则需要添加(在左侧)。或者,如果缺少工作表2,则需要添加(在右侧)。如果两者都缺失,则都需要添加。应该没有其他工作表了。

到目前为止,我有两个模块。一个检查一张纸,一个检查另一张纸。问题是,我正在努力寻找一种方法来无缝检查是否需要添加哪些工作表,并按照上述方式对其进行格式化(即,数据集工作表在左边,分析工作在右边,没有其他工作表)。

非常感谢您!

Option Explicit
Public szTodayRtsMU As String
Dim szTodayRawData As String


' Add and name a sheet with today's date.
Sub AddRtsMUsSheets_Today()

 ' Date and title.
szTodayRtsMU = Format(Date, "dd-mm-yyyy") & " " & "Rts & MUs"


On Error GoTo MakeSheet

 ' Check if sheet already exists, if it does, select activate it.
Sheets(szTodayRtsMU).Activate

 ' No errors, code is done.
Exit Sub


MakeSheet:
 ' If the sheet doesn't exist, add it.
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
 ' Name it
ActiveSheet.Name = szTodayRtsMU
End Sub

Sub AddRawDataSheets_Today()

 ' Date and title.
szTodayRawData = Format(Date, "dd-mm-yyyy") & " " & "Raw Data"


On Error GoTo MakeSheet

 ' Check if sheet already exists, if it does, select activate it.
Sheets(szTodayRawData).Activate

 ' No errors, code is done.
Exit Sub

MakeSheet:
 ' If the sheet doesn't exist, add it.
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
 ' Name it
ActiveSheet.Name = szTodayRawData
End Sub

1 个答案:

答案 0 :(得分:0)

经过测试,可以100%工作:

Option Explicit
Sub CheckForWorksheets()

    Dim szTodayRawData As String
    Dim szTodayRtsMU As String
    Dim ws As Worksheet
    Dim countRawData As Byte 'check if exists the RawData sheet
    Dim countRTsMU As Byte 'check if exists the RtsMU sheet

    'Date and titles
    szTodayRawData = Format(Date, "dd-mm-yyyy") & " " & "Raw Data"
    szTodayRtsMU = Format(Date, "dd-mm-yyyy") & " " & "Rts & MUs"

    'Initialize the counters with 1
    countRawData = 1
    countRTsMU = 1

    'This is a loop on all the worksheets on this workbook
    For Each ws In ThisWorkbook.Worksheets
        'If the sheets exists then the counter goes to 0
        If ws.Name = szTodayRawData Then
            countRawData = 0
        ElseIf ws.Name = szTodayRtsMU Then
            countRTsMU = 0
        End If
    Next ws

    'Add the sheets if needed
    With ThisWorkbook
        If countRawData = 1 Then
            Set ws = .Sheets.Add(before:=.Sheets(.Sheets.Count))
            ws.Name = szTodayRawData
        End If
        If countRTsMU = 1 Then
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = szTodayRtsMU
        End If
    End With

    'Delete any other sheet
    For Each ws In ThisWorkbook.Sheets
        If Not ws.Name = szTodayRawData And Not ws.Name = szTodayRtsMU Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws

End Sub

如果您需要帮助来理解代码,请问我什么。