返回列表 上一主題 發帖

[分享] 在range中尋找自已想要的值,並且底格變色

[分享] 在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

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

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

TOP

        靜思自在 : 改變自己是自救,影響別人是救人。
返回列表 上一主題