VBA代碼基於A列中的值創建圖紙

Question

我正在尋找一個代碼來創建名稱為A列的工作表。我已經使用了此代碼，但並不能滿足我的要求。 代碼是；

Private Sub CommandButton1_Click()    
Dim sheetCount As Integer    
Dim sheetName As String    
Dim workbookCount As Integer    

With ActiveWorkbook    
sheetCount = Sheets(1).Range("A2").End(xlDown).Row    
For i = 2 To sheetCount Step 1    
sheetName = .Sheets(1).Range("A" & i).Value    
workbookCount = .Worksheets.Count    
.Sheets.Add After:=Sheets(workbookCount)    
.Sheets(i).Name = sheetName    
'.Sheets(i).Range("A" & i, "F" & i).Value = .Sheets("sample").Range("A" & i, "F" & i).Value    
Next    
End With    

Worksheets(1).Activate    

End Sub

第一次運行此代碼后，它將創建帶有A列中存在的文本的工作表。但是問題是，當我在該列中輸入新文本時，它也會生成以前的工作表。 我正在尋找一個代碼，該代碼僅使用在該列中輸入的新文本來創建工作表，而不創建已經完成的工作表。 請幫我解決這個問題，因為我嘗試了太多但是沒有找到任何代碼。

謝謝

Answer 1

您可以嘗試以下功能：

Function SheetExists(SheetName As String) As Boolean

Dim Test As Boolean

On Error Resume Next

Test = Sheets(SheetName).Range("A1").Select

If Test Then
    SheetExists = True
Else
    SheetExists = False
End If

End Function

以這種方式使用該函數：

Sub test()

If SheetExists("MySheet") Then
    MsgBox "Sheet exists"
Else
    MsgBox "Sheet is missing"
End If

End Sub

Answer 2

這對我有用，並經過測試：注意，如果嘗試使用保留的“歷史記錄”之類的名稱，則會出現錯誤。 我不知道所有保留名稱。

Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim sheetName As String
Dim workbookCount As Long
Dim ws As Worksheet
Dim match As Boolean

lastRow = Sheets("Sheet1").Range("A2").End(xlDown).Row

For i = 2 To lastRow
    match = False
    sheetName = Sheets("Sheet1").Cells(i, 1).Text

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name = sheetName Then
            match = True
        End If
    Next

    If match = False Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = sheetName
    End If

Next i

End Sub

編輯：添加了屏幕截圖

Answer 3

我的工作簿/個人工作簿中通常有這兩個輔助功能

Option Explicit

Function getSheetWithDefault(name As String, Optional wb As Excel.Workbook) As Excel.Worksheet
    If wb Is Nothing Then
        Set wb = ThisWorkbook
    End If

    If Not sheetExists(name, wb) Then
        wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)).name = name
    End If

    Set getSheetWithDefault = wb.Sheets(name)
End Function

Function sheetExists(name As String, Optional wb As Excel.Workbook) As Boolean
    Dim sheet As Excel.Worksheet

    If wb Is Nothing Then
        Set wb = ThisWorkbook
    End If

    sheetExists = False
    For Each sheet In wb.Worksheets
        If sheet.name = name Then
            sheetExists = True
            Exit Function
        End If
    Next sheet
End Function

要創建工作表，您只需遍歷工作表名稱並使用getSheetwithDefault函數

以下代碼演示了這一點：

sub createSheets()
    dim cursor as Range: set cursor = Sheets("Sheet1").Range("A2")

    while not isEmpty(cursor)
        getSheetWithDefault(name:=cursor.value)
        set cursor = cursor.offset(RowOffset:=1)
    wend
end