2016-04-15 73 views
0

我見過如何說「是單元格x在範圍y」,但因爲我使用VLookup我不知道如何協調這兩者。使用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

你會發現這裏也有範圍,但它們合併單元格。

+0

你試過'find'在活動工作表不同單元聯繫起來的? – findwindow

+0

我從來沒有使用'find'函數,沒有。 –

+0

今天學點新東西!編輯:呵呵。我看着你的桌子,我很困惑。你實際上建立了一個單元格到一列查找? – findwindow

回答

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 
相關問題