excelシートの作成と更新

Question

セルのリストに基づいてExcelでシートを作成する方法を探しています 問題リストを更新して追加シートを追加するかどうかを確認するスクリプトが必要ですシートを作成するための私は持っていないコードがある場合）すべてを作成したり、古いコピー

1を削除すると、エクセル（非VBA）

2）から、それが可能である再： が、私ならば、それは新しいentrysを作成します。再実行する（と私は更新を探しています）

Sub AddSheets() 
'Updateby Extendoffice 20161215 
    Dim xRg As Excel.Range 
    Dim wSh As Excel.Worksheet 
    Dim wBk As Excel.Workbook 
    Set wSh = ActiveSheet 
    Set wBk = ActiveWorkbook 
    Application.ScreenUpdating = False 
    For Each xRg In wSh.Range("A1:A7") 
     With wBk 
      .Sheets.Add after:=.Sheets(.Sheets.Count) 
      On Error Resume Next 
      ActiveSheet.Name = xRg.Value 
      If Err.Number = 1004 Then 
       Debug.Print xRg.Value & " already used as a sheet name" 
      End If 
      On Error GoTo 0 
     End With 
    Next xRg 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

このファンクションを使用して、ワークシートがすでに存在するかどうかを確認し、そのワークシートをスキップします。

Function WorksheetExists(sName As String) As Boolean 
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)") 
End Function 

だからあなたのコードは次のようになります

Sub AddSheets() 
    'Updateby Extendoffice 20161215 
    Dim xRg As Variant 
    Dim wSh As Excel.Worksheet 
    Dim wBk As Excel.Workbook 
    Set wSh = ActiveSheet 
    Set wBk = ActiveWorkbook 
    Application.ScreenUpdating = False 
    For Each xRg In wSh.Range("A1:A7") 
     If Not IsError(xRg) Then 
      If xRg <> "" Then 
       If Not WorkSheetExists((xRg)) Then 
        With wBk 
         .Sheets.Add after:=.Sheets(.Sheets.Count) 
         ActiveSheet.Name = xRg.Value 
        End With 
       End If 
      End If 
     End If 
    Next xRg 
    Application.ScreenUpdating = True 
End Sub 

Function WorksheetExists(sName As String) As Boolean 
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)") 
End Function 

Answer 2

ここでは別のオプションです。また、シートに列Aの名前を付ける部分を追加しました。 （必要に応じて削除できます）。

Sub AddSheets() 
'Updateby Extendoffice 20161215 
Dim xRg  As Excel.Range 
Dim wSh  As Excel.Worksheet 
Dim wBk  As Excel.Workbook 
Set wSh = ActiveSheet 
Set wBk = ActiveWorkbook 
Application.ScreenUpdating = False 
For Each xRg In wSh.Range("A1:A7") 
    With wBk 
     If Not sheetExists(xRg.Value) and xRg <> "" Then 
      .Sheets.Add after:=.Sheets(.Sheets.Count) 
      ActiveSheet.Name = xRg.Value 
     End If 
    End With 
Next xRg 
Application.ScreenUpdating = True 
End Sub 


Function sheetExists(sheetToFind As String) As Boolean 
'http://stackoverflow.com/a/6040454/4650297 
Dim sheet As Worksheet 
sheetExists = False 
For Each sheet In Worksheets 
    If sheetToFind = sheet.Name Then 
     sheetExists = True 
     Exit Function 
    End If 
Next sheet 
End Function