Question

我试图通过完成一个项目来教自己VBA，但不幸的是我已经达到了我能想出的极限。

该项目涉及一个工作簿，其工作表旨在用作其他工作表的模板。此工作表有多个表，由命名范围引用;表格和命名范围包括单词＆＃39; template＆＃39;。

将模板工作表复制七次到新工作簿中。复制后，立即将复制的工作表重命名为一周中的某一天。

我还需要重命名表和命名范围，但我已经发现如何通过替换＆＃39;模板＆＃39;来循环并重命名表。在一周中的适当日期，我无法弄清楚如何对命名范围做同样的事情。

命名范围以：

开头

AHSO_Tasks_Template 参考表 _01_AHSO_Tasks_Monday [AHSO任务] 范围星期一

这反映了一周中的其他六天，并且多次重复使用不同的单词集替换AHSO_Tasks。

我运行此代码，根据他们引用的表名称中包含的工作日重命名命名范围：

Sub Namedrangesloop()

Dim Nm As Name

'Loop through each named range in workbook
For Each Nm In ActiveWorkbook.Names

Dim oldrng As String
oldrng = Nm.Name

Dim rfto As String
rfto = Nm.RefersTo

Dim day As String
day = Mid(rfto, InStrRev(rfto, "_") + 1, InStr(rfto, "[") - InStrRev(rfto, "_") - 1)

Dim nwrng As String
nwrng = Replace(oldrng, "Template", day)

Nm.Name = nwrng

Next Nm

End Sub

这确实有效 - 对于上面的示例，名称管理器将命名范围显示为星期一！AHSO_Tasks_Monday（所以我只想更改范围，现在名称具有唯一的名称，而不是AHSO_Tasks_Template七次）。 / p>

但是当我保存并重新打开新工作簿时，我收到了消息：

Excel在filename.xlsx中找到了不可读的内容。您想恢复此工作簿的内容吗？（等）。

如果我单击是，我会在打开名称管理器时发现已删除所有已命名的范围！我该怎么做才能改变这个？

我确实想到了另一种选择，但我也坚持了这一点！

Answer 1

你的情况有两种选择......

选项1：本地工作表 - 本地命名范围。

在这种情况下，您的命名表使用相同的名称，但由表名称区分。

Sunday!AHSO_Tasks或Monday!AHSO_Tasks

显然，此选项不再需要重命名。

选项2：在复制时重命名每个表

您的指定表格仍然是全局的，但在复制时会在每张工作表上重命名，以避免混淆。

Option Explicit

Sub CreateWeekdaySheets()
    Dim srcWb As Workbook
    Dim dstWb As Workbook
    Dim tmplSh As Worksheet
    Dim daySh As Worksheet
    Dim weekDays() As String
    Dim day As Variant
    Dim tbl As ListObject
    Dim newName As String

    weekDays = Split("Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday", ",", , vbTextCompare)

    Set srcWb = ThisWorkbook
    Set dstWb = Workbooks.Add
    Set tmplSh = srcWb.Sheets("Template")

    For Each day In weekDays
        tmplSh.Copy After:=dstWb.Sheets(dstWb.Sheets.Count)
        Set daySh = ActiveSheet
        daySh.Name = CStr(day)
        For Each tbl In daySh.ListObjects
            newName = Replace(tbl.Name, "Template", day, , , vbTextCompare)
            tbl.Name = newName
        Next tbl
    Next day

End Sub

如果您的命名范围也未应用于Tables，这两个选项也应该有用。

Answer 2

我采用了PeterT的解决方案，添加了一个额外的For Each / Next循环，并获得了我想要的项目部分。但他值得信赖！

Sub CreateWeekdaySheets()

Dim srcWb As Workbook
Dim dstWb As Workbook
Dim tmplSh As Worksheet
Dim daySh As Worksheet
Dim weekDays() As String
Dim day As Variant
Dim tbl As ListObject
Dim newName As String

Dim nm As Name 'Added by me

weekDays = Split("Monday-Tuesday-Wednesday-Thursday-Friday-Saturday-Sunday", "-", , vbTextCompare)

Set srcWb = ThisWorkbook
Set dstWb = Workbooks.Add
Set tmplSh = srcWb.Sheets("DSP Template")

For Each day In weekDays
    tmplSh.Copy After:=dstWb.Sheets(dstWb.Sheets.Count)
    Set daySh = ActiveSheet
    daySh.Name = CStr(day)
    For Each tbl In daySh.ListObjects
        newName = Replace(tbl.Name, "Template", day, , , vbTextCompare)
        tbl.Name = newName
    Next tbl
    For Each nm In dstWb.Names 'Added by me
        nm.Name = Replace(nm.Name, "Template", day) 'Added by me
    Next nm 'Added by me
Next day

ActiveWindow.TabRatio = 0.7

End Sub

Excel VBA - 重命名命名范围会导致无法读取的内容错误？

2 个答案: