回圈計數器以增加變數值

我正在嘗試創建 VBA 代碼以根據當前日期命名作業表，但我正在努力解決一個問題，我需要一個計數器變數來命名作業表以便它們是唯一的，但我沒有得到它.

我正在嘗試 2 個代碼：

Sub COPIAR_MODELO()

Application.ScreenUpdating = False

    Dim i As Integer, x As Integer
    Dim shtname As String
    Dim WSDummy As Worksheet
    Dim TxtError As String
    Dim counter As Long
    counter = 0
    
Name01:
    For counter = 1 To 100 Step 0
    TxtError = ""
    counter = counter   1
    shtname = Format(Now(), "dd mm yyyy") & " - " & counter
    On Error Resume Next
    Set WSDummy = Sheets(shtname)
    If Not (WSDummy Is Nothing) Then TxtError = "Name taken, additional sheet added!"
    Next counter
    If TxtError <> "" Then MsgBox "" & TxtError: GoTo Name01
    Sheets("MODELO - NFS").Copy Before:=Sheets("MODELO - DEMAIS"): ActiveSheet.Name = shtname

Application.ScreenUpdating = True

End Sub

預期結果：

和

Sub COPIAR_MODELO()

Application.ScreenUpdating = False

    Dim i As Integer, x As Integer
    Dim shtname As String
    Dim WSDummy As Worksheet
    Dim TxtError As String
    Dim counter As Long
    
    TxtError = ""
    shtname = Format(Now(), "dd mm yyyy")
    On Error Resume Next
    Set WSDummy = Sheets(shtname)
    If Not (WSDummy Is Nothing) Then TxtError = "Name taken, additional sheet added!"
    If TxtError <> "" Then MsgBox "" & TxtError: GoTo Name01
    If TxtError = "" Then GoTo NameOK
    
Name01:
    For counter = 1 To 100 Step 1
    counter = counter   1
    shtname = Format(Now(), "dd mm yyyy") & " - " & counter
    Next counter
NameOK:
    Sheets("MODELO - NFS").Copy Before:=Sheets("MODELO - DEMAIS"): ActiveSheet.Name = shtname

Application.ScreenUpdating = True

End Sub

預期結果：

我將把這段代碼分配給一個形狀，以根據當前日期創建作業表。我特別喜歡結果 2，但是任何有效的代碼都會對我有所幫助，在此先感謝您的關注！！

uj5u.com熱心網友回復：

復制模板

Sub CopyTemplate()
    
    Const PROC_TITLE As String = "Copy Template"
    Const TEMPLATE_WORKSHEET_NAME As String = "MODELO - NFS"
    Const BEFORE_WORKSHEET_NAME As String = "MODELO - DEMAIS"
    Const DATE_FORMAT As String = "dd mm yyyy"
    Const DATE_NUMBER_DELIMITER As String = " - "
    Const FIRST_NUMBER As Long = 2
    Const FIRST_WORKSHEET_HAS_NUMBER As Boolean = False
    Const INPUT_BOX_PROMPT As String = "Input number of worksheets to create."
    Const INPUT_BOX_DEFAULT As String = "1"
    
    Dim WorksheetsCount As String: WorksheetsCount _
        = InputBox(INPUT_BOX_PROMPT, PROC_TITLE, INPUT_BOX_DEFAULT)
    If Len(WorksheetsCount) = 0 Then Exit Sub
    
    Dim DateName As String: DateName = Format(Date, DATE_FORMAT)
    
    Dim NewName As String: NewName = DateName
    Dim NewNumber As Long: NewNumber = FIRST_NUMBER
    
    If FIRST_WORKSHEET_HAS_NUMBER Then
        NewName = NewName & DATE_NUMBER_DELIMITER & NewNumber
        NewNumber = NewNumber   1
    End If
        
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim wsTemplate As Worksheet
    Set wsTemplate = wb.Worksheets(TEMPLATE_WORKSHEET_NAME)
    Dim wsBefore As Worksheet
    Set wsBefore = wb.Worksheets(BEFORE_WORKSHEET_NAME)
    
    Dim wsNew As Worksheet
    Dim WorksheetNumber As Long
    
    Application.ScreenUpdating = False
    
    Do While WorksheetNumber < WorksheetsCount
        On Error Resume Next
            Set wsNew = wb.Worksheets(NewName)
        On Error GoTo 0
        If wsNew Is Nothing Then
            wsTemplate.Copy Before:=wsBefore
            wsBefore.Previous.Name = NewName
            WorksheetNumber = WorksheetNumber   1
        Else
            NewName = DateName & DATE_NUMBER_DELIMITER & NewNumber
            NewNumber = NewNumber   1
            Set wsNew = Nothing
        End If
    Loop

    Application.ScreenUpdating = True
    
    MsgBox WorksheetsCount & " worksheet" & IIf(WorksheetsCount = 1, "", "s") _
        & " created.", vbInformation, PROC_TITLE

End Sub

如果玩得太過...

Sub DeleteCreatedWorksheets()
    
    Const PROC_TITLE As String = "Delete Created Worksheets"
    Const BEFORE_WORKSHEET_NAME As String = "MODELO - DEMAIS"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim wsBefore As Worksheet
    Set wsBefore = wb.Worksheets(BEFORE_WORKSHEET_NAME)
    
    Dim wsIndex As Long: wsIndex = wsBefore.Index - 1
    
    If wsIndex > 0 Then
        Application.DisplayAlerts = False
            Dim n As Long
            For n = wsIndex To 1 Step -1
                wb.Worksheets(n).Delete
            Next n
        Application.DisplayAlerts = True
    End If
    
    MsgBox wsIndex & " created worksheet" _
        & IIf(wsIndex = 1, "", "s") & " deleted.", _
        vbInformation, PROC_TITLE

End Sub

標籤：擅长VBA

上一篇：當我嘗試計算兩個日期之間的時間時出現型別不匹配錯誤

下一篇：使用JSONCOVERTER創建JSON