VBA从列表中添加工作表

Question

我还是 VBA 的新手，我无法让一些代码正常工作。我有一个子，我想根据名为 AllCities 的工作表中的名称列表创建工作表。城市名称列表从单元格 A2 开始。工作表需要以列表中的单元格值命名，并且列表应该能够更新。代码现在可以工作，但如果我添加到名称列表中，它不会添加新的工作表。我的第二个子应该删除与列表中的城市不对应的任何工作表。我的删除子现在只是删除每个工作表。

插入工作表代码：

Sub insertSheets()

Dim myCell As Range
Dim MyRange As Range
Dim MyRange2 As Range

Set MyRange = Sheets("AllCities").Range("A2")
Set MyRange2 = Range(MyRange, MyRange.End(xlDown))

For Each myCell In MyRange2
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = myCell.Value

Next myCell

End Sub

删除工作表代码：

Sub deleteSheets()

Dim wks As Worksheet
Dim MyRange As Range
Dim myCell As Range

Set wks = Sheets("AllCities")

With wks
    Set MyRange = Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

On Error Resume Next
Application.DisplayAlerts = False
For Each myCell In MyRange
    Sheets(myCell.Value).Delete
Next myCell
Application.DisplayAlerts = True
On Error GoTo 0

End Sub

感谢您的帮助！

Answer 1

您正在尝试使用两种不同的方法（会产生不同的结果）来查找范围中的最后一个单元格。

在您的insertSheets 程序中，您正在使用：

Set MyRange2 = Range(MyRange, MyRange.End(xlDown))

这与按住 Ctrl 并按下向下键的效果相同，会在出现空白单元格之前找到最后一个单元格。

在您使用的deleteSheets 程序中：

Set MyRange = Range("A1", .Cells(.Rows.Count, "A").End(xlUp))

这与您在 insertSheets 过程中搜索的方式不同，因为它从工作表底部开始查找区域中真正的最后一个单元格。

我建议将您的insertSheets 程序修改为：

Sub insertSheets()

Dim myCell As Range
Dim MyRange As Range
Dim MyRange2 As Range

With Sheets("AllCities")
    Set MyRange = .Range("A2")
    Set MyRange2 = .Range(MyRange, .Rows.Count, "A").End(xlUp)
End With

For Each myCell In MyRange2
    If Not myCell.Value = vbNullString Then
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = myCell.Value
    End If
Next myCell

End Sub

这还将验证单元格不是空白的，从而防止 Excel 因您尝试将新工作表重命名为没有名称而引发错误。