Question

我有一个例行程序，用于填写下一周每一天商品市场的所有重要事件的日历。我在页面上放置了一个日历网格，每天有10个命名单元格，即Monday1，Monday2等等（现在每天只有10个，即Mononday10），每天列。 BTW细胞宽2细胞，深2细胞。很多时候，某一天有超过10个事件。我试图测试命名范围以查看它是否存在，如果不复制最后命名的范围单元格的格式，并将该单元格命名为系列中的下一个名称。

我只有两个与上述问题有关，首要的是如何测试以确定已存在的命名范围的名称。我目前正在通过整个ThisWorkbook.Names列表进行迭代，其中包含数千个命名范围。由于这个迭代在生成日历时可能会运行超过100次，因此它很慢（如预期的那样）。是否有更好，更快的方法来检查名称是否已作为命名范围存在？

第二个问题是如何复制4个单元格，合并单元格的格式，因为地址始终只作为左上角单元格出现，因此偏移范围不能正常工作。我已经破解了这个代码，至少为列中的下一个合并单元格组提供了合适的范围

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)

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

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

由于Range（“G22：H23”）与cCell相同，Range（“G22：H25”）与destRange相同。以下代码应该可以工作，但不能。

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，它就不起作用。

有关如何在需要时一次将该单元格格式化为一列单元格的任何想法？

更新

现在可以将格式从一个合并的单元格复制到另一个相同大小的单元格。出于某种原因将destRange设置为整个范围（复制单元格和pastecell整个范围，如宏录制器所示）但没有工作，但将destRange设置为需要格式化的单元格区域，然后进行cCell和destRange的联合工作，并进行命名新范围更容易。

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设置为先前的范围名称并运行代码以复制合并的单元格格式并命名新范围可以正常工作。这是代码

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：$ H $ 23

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

联合在一起：$ G $ 22：$ H $ 25

但是如果需要创建多个新命名范围，则第二次通过此代码生成一个范围区域，如下面显示的输出所示

CCELL：$ G $ 24：$ H $ 25

那么为什么cCell的地址在第一次运行时只显示左上角的单元格地址，而第二次通过cCell的地址显示为整个合并的单元格范围？因为它确实如此，下一个代码行会产生一个范围对象错误

Set cCell = cCell.MergeArea

消除该代码行并修改第一个设置cCell到此;

Set cCell = Range(priorRangeName).MergeArea

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

Answer 1

首先，创建一个函数来调用命名范围。如果调用命名范围产生错误，该函数将返回False，否则它将返回True。

Function NameExist(StringName As String) As Boolean
    Dim errTest As String

    On Error Resume Next

    errTest = ThisWorkbook.Names(StringName).Value

    NameExist = CBool(Err.Number = 0)

    On Error GoTo 0
End Function

至于你的第二个问题，我对自动填充没有问题。

我会用Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)重新Set destRange = cCell.Resize(2,1)。它具有相同的效果，但后者更清洁。

Answer 2

最有效的方法是不检查它是否存在。相反，您可以忽略错误并继续：

 On Error GoTo label1
   ' your code here
 label1:
 If Err.Number <> 0 Then Debug.Print Err.Description ' optional if you want to check the error
 On Error GoTo 0  ' to reset the On Error GoTo label1

要获取合并单元格的范围，您可以使用cCell.MergeArea
https://msdn.microsoft.com/en-us/library/office/ff822300.aspx

Answer 3

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

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

y = rvvar*randn(L)

这是我跑的测试。

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

<强>之前：

<强>后： .change()

Answer 4

我找到this on ozgrid并从中发挥了一点功能：

Option Explicit

Function DoesNamedRangeExist(VarS_Name As String) As Boolean
Dim NameRng As Name

For Each NameRng In ActiveWorkbook.Names
    If NameRng.Name = VarS_Name Then
        DoesNamedRangeExist = True
        Exit Function
    End If
Next NameRng

DoesNamedRangeExist = False
End Function

您可以将此行放入代码中进行检查：

DoesNamedRangeExist("Monday1")

它将返回一个布尔值（True / False），因此它易于使用IF()语句

至于你关于合并单元格的问题，我在一个2 * 2合并单元格上做了一个快速宏记录，它给了我这个（做了更小并添加了注释）：

Sub Macro1()
    Range("D2:E3").Copy 'Orignal Merged Cell
    Range("G2").PasteSpecial xlPasteAll 'Top left of destination
End Sub

VBA命名范围检查名称是否存在的最有效方法

4 个答案: