我已经看过如何说“细胞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
以下是我的查找表示例:
你会注意到这里有范围,但它们是合并的单元格。
答案 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