2016-02-29 179 views
3

我试图通过完成一个项目来教自己的VBA,但不幸的是我已经达到了我能想出的极限。Excel VBA - 重命名命名范围会导致无法读取的内容错误?

该项目涉及一个工作簿,其中的工作表打算用作其他工作表的模板。该工作表具有多个由命名范围引用的表格;表格和命名范围包含单词'模板'。

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

我也需要重命名表和命名范围,但是当我发现如何通过用适当的星期几取代'template'来循环和重命名表时,我无法弄清楚如何执行相同的命名范围。

命名的范围开始为:

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七倍)。

但是当我保存并重新打开新的工作簿,我得到的消息:

Excel中发现filename.xlsx不可读的内容。你想恢复这个工作簿的内容吗? (等等)。

如果我点击是,然后我找到当我打开名称管理器,所有命名的范围已被删除!我能做些什么来改变这一点?

我确实想到了另一种方法,但我也一直在这样做!

+0

听起来像你的工作簿有一个问题,这与VBA无关。我没有看到你显示的任何代码如何创建损坏的文件。 –

+0

如果点击“否”会发生什么? – findwindow

+0

好吧,这更糟糕:/我认为约翰的权利,其他东西是腐败的,但有趣的是它似乎只影响命名的范围。 – findwindow

回答

1

你在你的情况下,两个选项...

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

在这种情况下,您命名的表格使用相同的名称,但通过图纸名称进行区分。

Sunday!AHSO_TasksMonday!AHSO_Tasks

显然,重命名,不再需要使用此选项。

选项2:重命名每个表作为复制

您指定的表保持全球性的,但是当你为了避免混淆复制每张纸上都被重命名。如果您的命名范围不会应用到Tables以及

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 

这两个选项也应该工作。

+0

辉煌,谢谢彼得!荣誉花时间跟随我冗长的解释,并明白我正在尝试做什么。 我已经解决了这个问题,每天重复一次(但不是循环)一个尴尬和不必要的冗长的代码,但是您的解决方案更加优雅,并且教会了我更多关于VBA的知识。 此外,通过非常轻微地调整您的代码,我完成了我想要的事情(唯一命名范围匹配表和Global范围)。为了完整起见,我会添加它作为答案。 – TheBaffledKing

0

我拿了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