Excel VBA 命名范围范围和相交函数

Question

我有一张表格，用户可以在其中从下拉列表中选择一个值。然后我在另一张纸上搜索该值，并返回该单元格的地址。该地址被提供给一个函数，该函数查看每个命名范围并寻找相交。我已经在该函数上输入了一些“调试”信息，只是为了查看它是否正在触发，而事实并非如此。我有 3 张可能会看穿的工作表，所以我必须小心不要抛出 1004 错误来寻找不同工作表上的相交。我在这里不知所措。我确定这是愚蠢的，但我找不到它。任何帮助表示赞赏。

For i = 1 To EndWRow
    For j = 1 To EndWColumn
        If woodSearch = Worksheets("Woods").Cells(i, j).Value Then
            
            Worksheets("Woods").Activate
            
            x = ActiveSheet.Name
            y = Worksheets("Woods").Cells(i, j).Address
            Set wMatchCell = Worksheets("Woods").Cells(i, j)
            
            If IsNamedRange(wMatchCell, woodRangeName) Then
                MsgBox "Range Name:= " & woodRangeName.Name & Chr(10) & _
                    "Range RefersTo:= " & woodRangeName
                    
                woodRangeNameString = woodRangeName.Name
                'Worksheets("Woods").Range(woodRangeNameString).Copy
                'Worksheets("Bag 1").Range("B2:H23").PasteSpecial xlPasteValuesAndNumberFormats
                'Worksheets("Bag 1").Range("B2:H23").PasteSpecial xlPasteFormats
                'Worksheets("Bag 1").Range("B2:H23").PasteSpecial xlPasteColumnWidths
                
            Else
                MsgBox "Invalid Selection. Sheet name is: " & x & " and selected address is: " & y
            End If
            
            Exit For
            
        End If
    Next j
Next i

查找命名范围函数：

Function IsNamedRange(ByVal Target As Range, ByRef NamedRange As Name) As Boolean
Dim nm As Name
Dim i As Integer
i = 7

With ThisWorkbook.Sheets(Target.Parent.Name)
    For Each nm In .Names
        Sheets("User Entry").Range("B" & i).Value = nm
        If Not Application.Intersect(Target, Range(nm)) Is Nothing Then
                IsNamedRange = True
                Set NamedRange = nm
                Exit Function
        End If
    i = i + 1
    Next nm
End With
End Function

至少，我觉得这个函数至少应该在我的工作表上打印所有命名的范围（不是真的想要，但我把它扔进去调试），它什么也没做。总而言之，“else”最终会执行......

Answer 1

您可以进行一些更改以使其更通用。还更新了方法名称并将名称作为函数的返回值返回 - 我不确定 Boolean + ByRef 是否能得到比测试返回值更多的东西？

Sub Tester()
    Dim nm As Name
    
    Set nm = GetMatchedRange(Selection)
    If Not nm Is Nothing Then
        Debug.Print nm.Name, nm.RefersToRange.Address
    Else
        Debug.Print "no name"
    End If

End Sub

Function GetMatchedRange(ByVal Target As Range) As Name
    Dim nm As Name, i As Integer, rng As Range
    'always operate on the parent workbook of Target
    For Each nm In Target.Worksheet.Parent.Names
        'Sheets("User Entry").Range("B" & i).Value = nm
        Set rng = Nothing
        On Error Resume Next
        Set rng = nm.RefersToRange 'not all names refer to ranges...
        On Error GoTo 0
        If Not rng Is Nothing Then
            'does this name refer to a range on the same sheet as Target?
            If rng.Parent.Name = Target.Parent.Name Then
                If Not Application.Intersect(Target, rng) Is Nothing Then
                    Set GetMatchedRange = nm
                    Exit Function
                End If
            End If
        End If
        i = i + 1
    Next nm
End Function