[發問] 請教: 如何在同一SHEET 內顯示選取資料?

markoxp

各位師兄/姐好,

請問如圖中  , 如何當用戶點選右邊的名字時, 月曆中的相同名字會以顏色標示?
e.g:  如我選取右邊的 apple, 月曆中的所有"apple" 都會著色( 或其他形式) 標示出來.

下載 (117.82 KB)

2014-5-23 17:26

yen956

回復 1# markoxp
大大你好, 能不能附檔說明?

markoxp

回復  markoxp
大大你好, 能不能附檔說明?
yen956 發表於 2014-5-24 14:03

Microsoft Office Excel 工作表.zip (10.7 KB)

thanks
下載次數: 9

2014-5-26 15:34

先謝謝你的回復 :handshake

yen956

回復 3# markoxp
試試看:

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     Dim Rng As Range
   
3.    
   
4.     '限定 Worksheet_Change的範圍
   
5.     Set Rng = Range("L4:L12")
   
6.     If Not Intersect(Target, Rng) Is Nothing Then
   
7.         顯示查找資料 Target
   
8.     End If
   
9. End Sub
   
10. 
    
11. Sub 顯示查找資料(ByVal Target As Range)
    
12.     Dim sh As Worksheet
    
13.     Dim findRng, Rng As Range
    
14.     Dim str1 As String
    
15.    
    
16.     Set sh = Sheets("Sheet1")
    
17.    
    
18.     '設定 搜尋範圍
    
19.     Set findRng = sh.[C3].Resize(26, 6)
    
20.     findRng.Font.ColorIndex = 1  '先將字型顏色設為黑色
    
21.    
    
22.     Set Rng = findRng.Find(Target, LookAt:=xlPart)     '在 findRng 中 搜尋 ActiveCell, 部份搜尋
    
23.    
    
24.     If Rng Is Nothing Then
    
25.         MsgBox "找不到【" & ActiveCell & "】", vbCritical
    
26.         Exit Sub
    
27.         
    
28.     '搜尋結果變色顯示
    
29.     Else
    
30.         str1 = Rng.Address  '保存第一個搜尋結果的位址
    
31.         Do
    
32.             Rng.Font.ColorIndex = 3
    
33.             Set Rng = findRng.FindNext(Rng)    '尋找下一個 Target
    
34.         Loop Until Rng.Address = str1    '直到又回到第一個搜尋結果的位址
    
35.     End If
    
36.         
    
37. End Sub

複製代碼

markoxp

謝謝大大, 回家再試試看,  感謝