Проверьте наличие нескольких определенных листов и добавьте отсутствующие - PullRequest
0 голосов
/ 05 июня 2019

Я новичок и изо всех сил пытаюсь разработать логику, необходимую для программирования в целом.Надеюсь, кто-нибудь может мне помочь!

Я создаю простую рабочую книгу, которая состоит из двух листов.Один лист предназначен для набора данных, а второй - для анализа.Сначала будет установлен лист данных (слева / Лист1), затем второй лист анализа (справа / Лист2).Имя каждого листа будет иметь сегодняшнюю дату и заголовок.

Я хотел бы, чтобы скрипт проверял, присутствуют ли оба листа на сегодняшнюю дату.Если они есть, никаких действий не требуется.Если лист 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 голосов
/ 05 июня 2019

Протестировано, 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

Если вам нужна помощь в понимании кода, спросите меня что-нибудь.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...