使用VLookup查看所选单元格是否在某个范围内?

时间:2016-04-15 21:16:17

标签: excel vba excel-vba named-ranges

我已经看过如何说“细胞x在范围y中”,但是因为我正在使用VLookup我不确定如何调和这两者。

基本上,下面的代码会对包含提示的表进行查找,然后在指定的单元格中显示它们。它很棒。我喜欢做的是在查找表中指定整个单元格范围,然后如果用户选择该范围内的任何单元格,则显示提示。就目前而言,如果我有大面积的10个单元格,我必须在查找表中创建10个重复条目(每个单元格一个)。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cellTitle As Range
    Set cellTitle = Range("J2")
    Dim cellTip As Range
    Set cellTip = Range("J3")

    If Target.Address = "$J$3:$K$5" Or Target.Address = "$J$2:$K$2" Or Target.Address = "$K$1" Then
        'leave existing content in case user wants to copy tip
    Else
        Range("K1").Value = Target.Address
        Title = Application.VLookup(Target.Address, Sheets("Settings").Range("TipsDashboard"), 2, False)
        If Not IsError(Title) Then
            Tip = Application.VLookup(Target.Address, Sheets("Settings").Range("TipsDashboard"), 3, False)
            cellTitle.Value = Title
            cellTip.Value = Tip
        Else
            cellTitle.Value = "Tips & Instructions"
            cellTip.Value = "Try selecting various fields to get dynamic tips or instructions in this space."
        End If
    End If
End Sub

以下是我的查找表示例:

enter image description here

你会注意到这里有范围,但它们是合并的单元格。

1 个答案:

答案 0 :(得分:0)

已编辑:这样可以将活动工作表中的不同单元格与“设置”工作表的“单元格”列中的相同范围值相关联

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal target As Range)
    Dim cellTitle As Range, cellTip As Range, found As Range

    Set cellTitle = Range("J2")
    Set cellTip = Range("J3")

    If target.address = "$J$3:$K$5" Or target.address = "$J$2:$K$2" Or target.address = "$K$1" Then
        'leave existing content in case user wants to copy tip
    Else
        Range("K1").Value = target.address

        Set found = GetCell(target, Sheets("Settings").Range("TipsDashboard").Columns(1))
        If Not found Is Nothing Then
            cellTitle.Value = found.Offset(, 1)
            cellTip.Value = found.Offset(, 2)
        Else
            cellTitle.Value = "Tips & Instructions"
            cellTip.Value = "Try selecting various fields to get dynamic tips or instructions in this space."
        End If
    End If
End Sub


Function GetCell(target As Range, sourceRng As Range) As Range
Dim cell As Range, cell2 As Range

With target
    For Each cell In sourceRng.SpecialCells(xlCellTypeConstants, xlTextValues)
        Set cell2 = GetRangeFromAddress(.Parent, cell.Value)
        If Not cell2 Is Nothing Then
            If Not Intersect(.cells, cell2) Is Nothing Then
                Set GetCell = cell
                Exit Function
            End If
        End If
    Next cell
End With

End Function


Function GetRangeFromAddress(sht As Worksheet, address As String) As Range

On Error Resume Next
Set GetRangeFromAddress = sht.Range(address)
On Error GoTo 0

End Function