Question

所以我要做的是根据源工作表（同一工作簿）中的单元格范围更新工作表列表。我知道我可以通过删除所有工作表并添加新工作表来实现这一点，但是我需要在它取出一个并添加另一个工作表的地方。

这是我到目前为止所遇到的问题，我的问题始于运行时没有响应的宏或我尝试将两个宏组合在一起以便将其链接到按钮时，没有任何反应。

Sub Delete_Insert()

Dim i As Integer
i = 2
Dim ws As Worksheet

Dim stocks As Variant

Dim c_stocks As Integer
c_stocks = 7
Dim match As Boolean
'This is to see if a worksheet matched with a stock name
Dim j As Integer
j = 1
'To count the internal cell FOR loop

Application.DisplayAlerts = False
'This turns off the alert for deleting sheets

For Each ws In Worksheets

c = ActiveWorkbook.Worksheets.Count
    match = False
        For Each stocks In ThisWorkbook.Sheets("Main").Range("A2:A8").Cells
            If CStr(stocks) = ActiveWorkbook.Sheets(i).name Then
                match = True
                Exit For 
            End If
            Next stocks
    If match = False Then
            ws.Delete
    End If
    i = i + 1
    If i = c Then
            Exit For
    End If
    Next ws
End Sub`

然后这是插入

For Each stocks In ThisWorkbook.Sheets("Main").Range("A2:A8").Cells
    i = 2
    match = False
        For Each ws In Worksheets
            If (ws.name = stocks) Then
                match = True
                Exit For

            End If

        i = i + 1


        Next ws

    If match = False Then

                ActiveWorkbook.Worksheets.Add
                ActiveSheet.Move After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
                ActiveSheet.name = CStr(stocks)
    End If

     j = j + 1

    If (j = 7) Then
        Exit For
    End If

    Next stocks


End Sub

Answer 1

像这样（未经测试）：

Sub Delete_Insert()

    Dim i As Integer
    Dim sht As Worksheet, wb As Workbook
    Dim stocks As Range, c As Range, stck As String

    Set wb = ActiveWorkbook
    Set stocks = ThisWorkbook.Sheets("Main").Range("A2:A8")

    'remove sheets not in list
    For i = wb.Worksheets.Count To 1 Step -1
        Set sht = wb.Worksheets(i)
        If IsError(Application.match(sht.Name, stocks, 0)) Then
            Application.DisplayAlerts = False
            sht.Delete
            Application.DisplayAlerts = False
        End If
    Next i

    'add new sheets from list
    For Each c In stocks.Cells
        stck = c.Value
        If Len(stck) > 0 Then

            Set sht = Nothing
            On Error Resume Next
            Set sht = wb.Worksheets(stck)
            On Error GoTo 0

            If sht Is Nothing Then
                With wb.Worksheets.Add(after:=wb.Sheets(wb.Sheets.Count))
                    .Name = stck
                End With
            End If

        End If
    Next c

End Sub

VBA宏，可以根据源工作表单元格范围更新工作表

1 个答案: