- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
4#
發表於 2014-5-26 20:32
| 只看該作者
回復 3# markoxp
試試看:- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Dim Rng As Range
-
- '限定 Worksheet_Change的範圍
- Set Rng = Range("L4:L12")
- If Not Intersect(Target, Rng) Is Nothing Then
- 顯示查找資料 Target
- End If
- End Sub
- Sub 顯示查找資料(ByVal Target As Range)
- Dim sh As Worksheet
- Dim findRng, Rng As Range
- Dim str1 As String
-
- Set sh = Sheets("Sheet1")
-
- '設定 搜尋範圍
- Set findRng = sh.[C3].Resize(26, 6)
- findRng.Font.ColorIndex = 1 '先將字型顏色設為黑色
-
- Set Rng = findRng.Find(Target, LookAt:=xlPart) '在 findRng 中 搜尋 ActiveCell, 部份搜尋
-
- If Rng Is Nothing Then
- MsgBox "找不到【" & ActiveCell & "】", vbCritical
- Exit Sub
-
- '搜尋結果變色顯示
- Else
- str1 = Rng.Address '保存第一個搜尋結果的位址
- Do
- Rng.Font.ColorIndex = 3
- Set Rng = findRng.FindNext(Rng) '尋找下一個 Target
- Loop Until Rng.Address = str1 '直到又回到第一個搜尋結果的位址
- End If
-
- End Sub
 |
|
