excel表單的創建和更新

我正在尋找一種方法來創建基於單元格列表的Excel表格問題我想要腳本來檢查列表是否已更新並添加附加表單而不是重新創建所有或刪除舊的副本excel表單的創建和更新

1）是否有可能從Excel（非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

來源

2017-05-15 user2740068

你是什麼意思的「更新」。你只是想多次運行這個，只添加新的工作表，如果它不存在？ – BruceWayne

是的，如果在該範圍的單元格中沒有值，則跳過它 – user2740068

使用此函數檢查工作表是否已經存在，然後讓它跳過它。

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

來源

2017-05-15 21:11:06 dwirony

它可以工作，但是每次執行時我都會得到一個「類型不匹配」錯誤 – user2740068

是的，我剛修復它。我必須將xRg更改爲變體而不是範圍，以便該函數可以接受參數。立即嘗試更新的代碼。 – dwirony

爲什麼你有一個「什麼都不做」塊？反轉條件並刪除多餘的「Else」！ ..以及在外部條件下多餘的「Else」！ ...並修復縮進。 –

這裏的另一種選擇。我還添加了一個部分，它將爲工作表命名列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

來源

2017-05-15 21:28:14 BruceWayne

excel表單的創建和更新

回答

相關問題