Verwenden von Worksheet.Change-Ereignis, um ein neues Arbeitsblatt hinzuzufügen

Question

Ich habe eine Reihe von Zellen (speziell D6: D34), wo alle Werte in den Zellen eine entsprechende Tabelle haben. Da ich Arbeitsblätter nur manuell hinzugefügt habe, wenn ich einen neuen Wert hinzufüge (oder einen Zellenwert ändere), denke ich darüber nach, Private Sub Worksheet_Change(ByVal Target as Range) zu verwenden, um die automatische Erstellung eines Arbeitsblatts zu ermöglichen, wenn sich die Zellen ändern. Dies ist, was ich versucht habe zu verwenden, aber jetzt bekomme ich einen Fehler, dass der "Blattname bereits existiert", wie es die ganze Spalte nach unten schaut. Ich habe versucht, mit Fehlerbehandlung über diejenigen, die existieren, zu überspringen, aber es endet mit der nächsten zu überprüfen, aber "Sheet1" und "Sheet2", etc. irgendwelche Vorschläge, wie Sie dies einrichten?

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim hlValue As Range 
For Each hlValue In Sheets(1).Range("D6:D34") 
    ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count) 
    ActiveSheet.Name = hlValue 
Next 
End Sub 

Ich sollte auch sagen, dass, wenn einer der Zelle Wert gelöscht wird, sollte das Arbeitsblatt auch gelöscht werden. Eine Art von If CellValue <> Exist, Delete? Ich konnte nichts finden, um zu prüfen, ob es neben ausgefallenen Funktionen existiert. Sollte ich einen von diesen verwenden?

EDIT: Okay, ich habe das jetzt. Dies sollte ausreichen.

Private Sub Worksheet_Change(ByVal Target As Range) 
Application.DisplayStatusBar = True 
Application.ScreenUpdating = False 'Run faster 
Application.DisplayAlerts = False 'Just in case 
Dim shtName As Variant 
For Each shtName In Sheets(1).Range("D6:D34") 
If WorksheetExists((shtName)) Then 
'do nothing 
Else 
    ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count) 
    ActiveSheet.Name = shtName 
Application.StatusBar = "Creating new sheet for " & shtName 'Just in case it's running slowly 
Sheets("Admin").Select 
End If 
Next 
Application.StatusBar = "READY" 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 
End Sub 
Function WorksheetExists(sName As String) As Boolean 
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)") 
End Function 

Answer 1

ich nichts, wenn es neben Phantasie Funktionen vorhanden zu verwenden, finden kann, zu überprüfen. Sollte ich einen von diesen verwenden?

Ja, Sie sollten! Arbeitsblätter sind Teil eines Collection Objekts und es gibt keine integrierte Exists (oder ähnliche) Methode, die Sie abfragen können. Solch eine Funktion ist nicht schick :) und es wäre eine gute Einführung in die Verwendung von Funktionen und/oder das Aufrufen anderer Unterprogramme, wenn Sie das nicht bereits kennen.

Bei der einfachsten:

Function SheetExists(sName As String) As Boolean 
    Dim w as Worksheet 
    On Error Resume Next 
    Set w = Worksheets(sName) 
    SheetExists = Not w Is Nothing 
End Function 

Wie das funktioniert:

If SheetExists("sheet1") Then 
    'Do something 
Else 
    'Sheet doesn't exist, so do something else 
End If 

Sie einen String-Wert der Funktion als sName passieren. Die Funktion gibt dann True oder False zurück, ob dieses Blatt existiert.

Zuerst versucht die Funktion SheetExists, eine Worksheet Variable auf das angegebene Arbeitsblatt zu setzen, namentlich. Dies wird voraussichtlich fehlschlagen, wenn der Arbeitsblattname nicht vorhanden ist, so dass wir dieses Wissen zusammen mit der Resume Next-Anweisung verwenden. Im Falle eines Fehlers wird w kein Arbeitsblatt zugewiesen und bleibt ein Nothing, und dann verwenden wir einen booleschen Ausdruck (Not w Is Nothing) als Rückgabewert der Funktion. Wenn das Blatt existiert, wird w nichts sein, daher gibt die Funktion True zurück, und wenn das Blatt nicht existiert, wird wNothing sein, so dass die Funktion False zurückgibt.

Die obige Funktion verwendet nur ActiveWorkbook, sodass eine robustere Version auch die Angabe einer übergeordneten Arbeitsmappe ermöglicht.

Function SheetExists(sName As String, Optional wb as Workbook = Nothing) As Boolean 
    'This function checks whether worksheet 'sName' exists in 
    ' workbook object 'wb'. If no parameter is passed for 'wb' then 
    ' assume to use the ActiveWorkbook 
    Dim w as Worksheet 
    If wb Is Nothing Then Set wb = ActiveWorkbook 
    On Error Resume Next 
    Set w = wb.Worksheets(sName) 
    SheetExists = Not w Is Nothing 
End Function 

NB: Es gibt relativ wenige Fälle, in denen On Error Resume Next nicht verpönt, aber dies in einem sehr kleinen und spezifischen Funktion verwenden, mit einem gut definierten Zweck und Erwartung ist OK.

Alternativ können die Elemente der Kollektion Brute-Force-Iteration kann auch verwendet werden Sammlungen für Existenz abzufragen, und dies beruht nicht auf On Error Resume Next:

Function SheetExists2(sName as String) As Boolean 
    Dim ws as Worksheet, ret as Boolean 
    For Each ws In ActiveWorkbook.Worksheets 
     If ws.Name = sName Then 
      ret = True 
      Exit For 
     End If 
    Next 
    SheetExists2 = ret 
End Function