Find یک گزینه بسیار قدرتمند در اکسل است و بسیار مفید است. همراه با تابع Offset می توانید سلول های اطراف سلول پیدا شده را نیز تغییر دهید. در زیر چند مثال اساسی وجود دارد که می توانید در کد خود از آنها استفاده کنید. برای انتخاب یک سلول از Find استفاده کنید مثال‌های زیر در ستون A یک برگه با نام "Sheet1" مقدار صندوق ورودی را جستجو می‌کنند. نام برگه یا محدوده موجود در کد را به شیت/محدوده خود تغییر دهید. نکته: می توانید جعبه ورودی را با یک رشته یا یک مرجع به سلولی مانند این جایگزین کنید FindString = "SearchWord" یا FindString = Sheets("Sheet1").Range("D1").Value این مثال اولین سلول در محدوده با مقدار InputBox را انتخاب می کند. Sub Find_First() Dim FindString As String Dim Rng As Range FindString = InputBox("Enter a Search value") If Trim(FindString) <> "" Then With Sheets("Sheet1").Range("A:A") Set Rng = .Find(What:=FindString, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then Application.Goto Rng, True Else MsgBox "Nothing found" End If End With End If End Sub اگر بیش از یک مورد از مقدار داشته باشید، آخرین رخداد انتخاب می شود. Sub Find_Last() Dim FindString As String Dim Rng As Range FindString = InputBox("Enter a Search value") If Trim(FindString) <> "" Then With Sheets("Sheet1").Range("A:A") Set Rng = .Find(What:=FindString, _ After:=.Cells(1), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False) If Not Rng Is Nothing Then Application.Goto Rng, True Else MsgBox "Nothing found" End If End With End If End Sub اگر تاریخ در ستون A دارید، این مثال سلولی را با تاریخ امروز انتخاب می کند. توجه: اگر تاریخ های شما فرمول هستند، ممکن است در مثال زیر xlFormulas را به xlValues ​​تغییر دهید. اگر تاریخ های شما دارای مقادیر هستند xlValues ​​همیشه با برخی از قالب های تاریخ کار نمی کند. Sub Find_Todays_Date() Dim FindString As Date Dim Rng As Range FindString = CLng(Date) With Sheets("Sheet1").Range("A:A") Set Rng = .Find(What:=FindString, _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then Application.Goto Rng, True Else MsgBox "Nothing found" End If End With End Sub سلول های با همان مقدار را در ستون A در ستون B علامت گذاری کنید این مثال در Sheets ("Sheet1") در ستون A برای هر سلول با "ron" جستجو می کند و از Offset برای علامت گذاری سلول در ستون سمت راست استفاده می کند. توجه: می توانید مقادیر بیشتری به آرایه MyArr اضافه کنید. Sub Mark_cells_in_column() Dim FirstAddress As String Dim MyArr As Variant Dim Rng As Range Dim I As Long With Application .ScreenUpdating = False .EnableEvents = False End With 'Search for a Value Or Values in a range 'You can also use more values like this Array("ron", "dave") MyArr = Array("ron") 'Search Column or range With Sheets("Sheet1").Range("A:A") 'clear the cells in the column to the right .Offset(0, 1).ClearContents For I = LBound(MyArr) To UBound(MyArr) 'If you want to find a part of the rng.value then use xlPart 'if you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "ron" Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do 'mark the cell in the column to the right if "Ron" is found Rng.Offset(0, 1).Value = "X" Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub سلول‌ها را با مقدار یکسان در یک محدوده، کاربرگ یا همه کاربرگ‌ها رنگ کنید این مثال تمام سلول‌های محدوده Sheets ("Sheet1").Range ("B1:D100") را با "ron" رنگ می‌کند. اگر می‌خواهید از تمام سلول‌های کاربرگ استفاده کنید، نظرات را در کد مشاهده کنید. من از شاخص رنگ در این مثال برای دادن رنگ 3 به تمام سلول های دارای "ron" استفاده می کنم (معمولی قرمز است) برای همه 56 شماره فهرست به این سایت مراجعه کنید http://dmcritchie.mvps.org/excel/colors.htm نکته: برای تغییر رنگ فونت به خطوط مثال زیر ماکروها مراجعه کنید. Sub Color_cells_In_Range_Or_Sheet() Dim FirstAddress As String Dim MySearch As Variant Dim myColor As Variant Dim Rng As Range Dim I As Long 'Fill in the search Value and color Index MySearch = Array("ron") myColor = Array("3") 'You can also use more values in the Array 'MySearch = Array("ron", "jelle", "judith") 'myColor = Array("3", "6", "10") 'Fill in the Search range, for the whole sheet use 'you can use Sheets("Sheet1").Cells With Sheets("Sheet1").Range("B1:D100") 'Change the fill color to "no fill" in all cells .Interior.ColorIndex = xlColorIndexNone For I = LBound(MySearch) To UBound(MySearch) 'If you want to find a part of the rng.value then use xlPart 'if you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to MySearch(I) Set Rng = .Find(What:=MySearch(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rng.Interior.ColorIndex = myColor(I) Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With End Sub نمونه ای برای همه کاربرگ های کتاب کار. Sub Color_cells_In_All_Sheets() Dim FirstAddress As String Dim MySearch As Variant Dim myColor As Variant Dim Rng As Range Dim I As Long Dim sh As Worksheet 'Fill in the search Value and color Index MySearch = Array("ron") myColor = Array("3") 'You can also use more values in the Array 'MySearch = Array("ron", "jelle", "judith") 'myColor = Array("3", "6", "10") For Each sh In ActiveWorkbook.Worksheets 'Fill in the Search range, for a range on each sheet 'you can also use sh.Range("B1:D100") With sh.Cells 'Change the fill color to "no fill" in all cells .Interior.ColorIndex = xlColorIndexNone For I = LBound(MySearch) To UBound(MySearch) 'If you want to find a part of the rng.value then use xlPart 'if you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to MySearch(I) Set Rng = .Find(What:=MySearch(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rng.Interior.ColorIndex = myColor(I) Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With Next sh End Sub سلول ها را با Find در برگه دیگری کپی کنید مثال زیر تمام سلول‌ها را با یک آدرس ایمیل در محدوده Sheets("Sheet1").Range("A1:E100") در یک کاربرگ جدید در کتاب کار شما کپی می‌کند. توجه: من از xlPart در کد به جای xlWhole برای پیدا کردن هر سلول با کاراکتر @ استفاده می کنم. Sub Copy_To_Another_Sheet_1() Dim FirstAddress As String Dim MyArr As Variant Dim Rng As Range Dim Rcount As Long Dim I As Long Dim NewSh As Worksheet With Application .ScreenUpdating = False .EnableEvents = False End With 'Fill in the search Value MyArr = Array("@") 'You can also use more values in the Array 'myArr = Array("@", "www") 'Add new worksheet to your workbook to copy to 'You can also use a existing sheet like this 'Set NewSh = Sheets("Sheet2") Set NewSh = Worksheets.Add With Sheets("Sheet1").Range("A1:Z100") Rcount = 0 For I = LBound(MyArr) To UBound(MyArr) 'If you use LookIn:=xlValues it will also work with a 'formula cell that evaluates to "@" 'Note : I use xlPart in this example and not xlWhole Set Rng = .Find(What:=MyArr(I), _ After:=.Cells(.Cells.Count), _ LookIn:=xlFormulas, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then FirstAddress = Rng.Address Do Rcount = Rcount + 1 Rng.Copy NewSh.Range("A" & Rcount) ' Use this if you only want to copy the value ' NewSh.Range("A" & Rcount).Value = Rng.Value Set Rng = .FindNext(Rng) Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress End If Next I End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub اطلاعات بیشتر اگر می‌خواهید فقط مقادیر را در کاربرگ خود جایگزین کنید، می‌توانید از Replace manual (Ctrl+h) یا از Replace در VBA استفاده کنید. کد زیر جایگزین ron برای دیو در کل کاربرگ می شود. اگر می‌خواهید سلول‌ها را فقط با ron جایگزین کنید، xlPart را به xlWhole تغییر دهید. ActiveSheet.Cells.Replace What:="ron", Replacement:="dave", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, _ SearchFormat:=False, ReplaceFormat:=False