標題: [分享] 在range中尋找自已想要的值，並且底格變色 [打印本頁]

---

作者: pegawang    時間: 2016-8-21 20:30     標題: 在range中尋找自已想要的值，並且底格變色

給各位作分享了，小弟也是從論壇上找資料自已編譯的。
Sub Find()
Dim FindString As Integer
Dim FirstAddress As String
FindString = InputBox("請輸入數值")
Dim oRng As Range
Set oRng = Range("E1:I3000").Find(what:=FindString, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlRows, matchbyte:=True)
If Not oRng Is Nothing Then
FirstAddress = oRng.Address
Do
Debug.Print oRng.Row, oRng.Address, oRng.Value
Set oRng = Range("E1:I3000").FindNext(oRng)
oRng.Interior.ColorIndex = 4
oRng.Offset(0, 7).Interior.ColorIndex = 4
Loop While Not oRng Is Nothing And oRng.Address <> FirstAddress
End If
End Sub

---

作者: pegawang    時間: 2016-8-21 20:32

喔，對了
oRng.Offset(0, 7).Interior.ColorIndex = 4
可以弄除，因為小弟是有對照兩者同時會變色。

---

作者: GBKEE    時間: 2016-8-26 06:29

回復 2# pegawang
也可如此寫法

1. Option Explicit
   
2. Sub Ex()  'Sub Find()  :Find 是VBA專屬的文字程式的名稱避免使用
   
3.     Dim FindString As String
   
4.     FindString = InputBox("請輸入數值")
   
5.     If FindString <> "" Then
   
6.         With Range("E1:I3000")
   
7.             .Cells.Replace FindString, "=1/0", xlWhole           '**輸入的文字替換為錯誤值
   
8.             On Error Resume Next                                          '**不理會程式上的錯誤,繼續執行程式
   
9.            With .SpecialCells(xlCellTypeFormulas, xlErrors)  '**沒有錯誤值, 程式會錯誤而中斷
   
10.                 If Err = 0 Then
    
11.                     .Parent.Cells.Interior.ColorIndex = xlNone
    
12.                     .Value = FindString
    
13.                    .Interior.ColorIndex = 4
    
14.                 Else
    
15.                     MsgBox "找不到  " & FindString
    
16.                 End If
    
17.             End With
    
18.         End With
    
19.     End If
    
20. End Sub

複製代碼

---

作者: pegawang    時間: 2016-8-28 00:03

天呀..小弟不材，版主寫的程式可得好好查書消化一番。

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)