VBA命名范围是检查名称是否存在的最有效方法 [英] VBA Named Range most efficient way to check if name exists

问题描述

我有一个例行程序，该例行程序将下周每一天的日程安排都包含了商品市场的所有重要事件.我在页面上布置了一个日历网格，每天在每一天列中有十个命名单元格，即星期一1，星期一2等(现在每天最多增加10个，即星期一10).顺便说一句，这些细胞宽2个细胞，深2个细胞.在特定的一天中，通常会有10多个事件.我正在尝试测试命名范围是否存在，如果没有，请复制上一个命名范围单元格的格式，并在该系列中使用下一个名称命名该单元格.

I have a routine, that fills a calendar with all important events for the commodity markets for each day of the following week. I have a calendar grid laid out on the page and have ten named cells for each day i.e. Monday1, Monday2 and so on (each day only goes up to 10 for now, i.e.Monday10), in each days column. BTW the cells are 2 cells wide and 2 cells deep. Many times there are more than 10 events for a given day. I am trying to test for the named range to see if it exists, if not copy the format of the last named range cell and name that cell the next name in the series.

我只有两个问题，首先是如何测试以确定名称范围中已经存在的名称.我目前正在遍历ThisWorkbook.Names的整个列表，其中包含数千个命名范围.由于在生成日历时此迭代可能会运行100多次，因此它的运行速度很慢(这是可以预期的).有没有更好，更快的方法来检查名称是否已经存在于命名范围内?

I am only having two issues with the above, first and foremost is how to test to determine in a name for a named range already exists. I am currently iterating thru the entire list of ThisWorkbook.Names, which has thousands of named ranges in it. Since this iteration could be running over 100 times when the calendar is generating, it is wicked slow (as would be expected). Is there a better, faster way to check if a name already exists as a named range?

第二个问题是如何复制4单元格(合并的单元格)的格式，因为该地址始终仅作为左上角的单元格出现，因此偏移范围无法正常工作.我四处寻找，以使此代码至少能为列中的下一个合并单元格找到合适的范围

The second issue is how to copy the formatting of a 4 cell, merged cell, since the address always comes up as only the top left corner cell so offsetting the range doesn't work appropriately. I hacked around to get this code to at least come up with the right range for the next merged cell group in the column

Set cCell = Range("Thursday" & CStr(y))
'even tho cCell is a 4 cell merged cell, cCell.Address returns the address of top left cell
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)

录制宏以将格式向下拖动，将显示此代码.

Recording a macro to drag the formatting down, shows this code.

Range("G22:H23").Select
Selection.AutoFill Destination:=Range("G22:H25"), Type:=xlFillFormats
Range("G22:H25").Select

由于Range("G22:H23")与cCell相同，而Range("G22:H25")与destRange相同.以下代码应该可以，但是不能.

Since Range("G22:H23") is the same as cCell, and Range("G22:H25") is the same as destRange. The following code should work, but doesn't.

Set cCell = Range("Thursday" & CStr(y))
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
cCell.AutoFill Destination:=destRange, Type:=xlFillFormats
Application.CutCopyMode = False
cCell.offset(1, 0).Name = rangeName

仅供参考，如果我选择cCell并使用Selection.AutoFill也不起作用.

FYI, it doesn't work if I select cCell and use Selection.AutoFill either.

有没有想过如何在需要的时候一次将格式化的单元格向下复制到一个单元格中?

Any thoughts on how to copy that cell formatting down the column one cell at a time when needed?

更新:

这现在可以将格式从一个合并的单元格复制到另一个相同大小的单元格.出于某种原因，将destRange设置为整个范围(宏记录器显示的复制单元格和pastecell整个范围)不起作用，但是将destRange设置为需要格式化的单元格范围，然后将cCell和destRange进行合并，并进行命名新范围更容易.

This now works for copying the formatting down from one merged cell to another of same size. For some reason setting destRange to the whole range (the copy cell and pastecell entire range as the macro recorder showed) didnt work but setting destRange to the cell range that needed formatting, and then doing a union of cCell and destRange worked, and made naming the new range easier.

rangeName = "Friday" & CStr(y + 1)
priorRangeName = "Friday" & CStr(y)
namedRangeExist = CheckForNamedRange(rangeName)
If namedRangeExist = False Then
    Set cCell = Range(priorRangeName) 
    Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
    cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
    Application.CutCopyMode = False
    destRange.Name = rangeName
End If

更新#2

For循环中的命名范围存在问题(以下代码在For循环内运行).第一次找不到新的rangeName时，将cCell设置为先前的范围名称，并运行代码以复制合并的单元格格式并命名新范围，即可正常工作.这是代码

There is an issue with naming ranges in a For loop ( the code below is running inside a For loop). The first time the new rangeName is not found, Setting cCell to the prior range name and running through the code to copy the merged cell format and name the new range works fine. Here is the code

rangeName = "Thursday" & CStr(y + 1)
priorRangeName = "Thursday" & CStr(y)
namedRangeExist = DoesNamedRangeExist(rangeName)
If namedRangeExist = False Then
    Set cCell = Range(priorRangeName)
    Debug.Print "cCell:" & cCell.Address
    Set cCell = cCell.MergeArea
    Debug.Print "Merged cCell:" & cCell.Address
    Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
    Debug.Print "Dest:" & destRange.Address
    Debug.Print "Unioned:" & Union(cCell, destRange).Address
    cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
    Application.CutCopyMode = False
    destRange.name = rangename
End If

结果在以下范围

cCell:$ G $ 22

cCell:$G$22

合并的cCell:$ G $ 22:$ H $ 23

Merged cCell:$G$22:$H$23

目的地:$ G $ 24:$ H $ 25

Dest:$G$24:$H$25

联盟(Unioned):$ G $ 22:$ H $ 25

Unioned:$G$22:$H$25

但是，如果第二次需要创建一个以上的新命名范围，则该代码将产生一个范围区域，如下面的输出所示

but if more than one new named range needs to be created the second time thru this code produces a range area as evidenced by the output shown below

cCell:$ G $ 24:$ H $ 25

cCell:$G$24:$H$25

那么为什么第一次运行时cCell的地址仅显示为左上角的单元格地址，而第二次通过cCell的地址却显示为整个合并的单元格范围?而且因为这样，下一行代码会产生范围对象错误

so why does cCell's address show as only the upper left cells address when run the first time, but the second time thru cCell's address is shown as the whole merged cell range? And because it does, the next code line produces a range object error

Set cCell = cCell.MergeArea

消除该代码行，并将第一个Set cCell修改为此；

Eliminating that code line and amending the first Set cCell to this;

Set cCell = Range(priorRangeName).MergeArea

产生相同的错误.我可以通过设置一个计数器来混淆这一点，如果不止一个，则绕过该代码行，但这不是首选的解决方案.

produces the same error. I could kludge this by setting a counter, and if more than one, bypass that code line but that is not the preferred solution.

推荐答案

我创建了一个扩展名称范围并填写格式的函数.该系列中的第一个命名范围必须进行设置.名称本身需要设置为合并区域中的左上方单元格.

I created a function to extend the name ranges and fill in the formatting. The first named range in the series will have to be setup. The Name itself needs to be set to the top left cell in the merged area.

ExtendFillNamedRanges将计算命名范围的位置.如果其中一个位置的单元格不是MergedArea的一部分，它将从最后一个命名范围开始向下填充格式.它将命名该单元格.名称的范围是工作簿.

ExtendFillNamedRanges will calculate the positions of the named ranges. If a cell in one of the positions isn't part of a MergedArea it will fill the formatting down from the last named range. It will name that cell. The scope of the names is Workbook.

Sub ExtendFillNamedRanges(BaseName As String, MaxCount As Integer)
    Dim x As Integer, RowCount As Integer, ColumnCount As Integer

    Dim LastNamedRange As Range, NamedRange As Range

    Set NamedRange = Range(BaseName & 1)

    RowCount = NamedRange.MergeArea.Rows.Count
    ColumnCount = NamedRange.MergeArea.Columns.Count

    For x = 2 To MaxCount
        Set NamedRange = NamedRange.Offset(RowCount - 1)
        If Not NamedRange.MergeCells Then
            Set LastNamedRange = Range(BaseName & x - 1).MergeArea
            LastNamedRange.AutoFill Destination:=LastNamedRange.Resize(RowCount * 2, ColumnCount), Type:=xlFillDefault
            NamedRange.Name = BaseName & x

        End If

        'NamedRange.Value = NamedRange.Name.Name
    Next

End Sub

这是我进行的测试.

Sub Test()
    Application.ScreenUpdating = False
    Dim i As Integer, DayName As String

    For i = 1 To 7
        DayName = WeekDayName(i)

        Range(DayName & 1).Value = DayName & 1

        ExtendFillNamedRanges DayName, 10
    Next i

    Application.ScreenUpdating = True
End Sub

之前:

之后:

这篇关于VBA命名范围是检查名称是否存在的最有效方法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！