[VBA] on the application of the Find method (Find method) (2)
fanjy published on 2006-9-28 20:26:00
5. Comprehensive example
5.1 Example 1: Enter data 5 and some other data in the cell range A1:A50 of the current worksheet, and then enter the following code in the VBE editor. After running, the program will find the cell where the value 5 is located in the range of cells A1:A50, and draw a blue ellipse in the found cell.
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub FindSample1()
Dim Cell As Range, FirstAddress As String
With Worksheets( 1).Range("A1:A50")
Set Cell = .Find(5)
If Not Cell Is Nothing Then
FirstAddress = Cell.Address
Do
With Worksheets(1).Ovals.Add(Cell.Left, _
Cell.Top, Cell.Width, _
Cell.Height)
.Interior.Pattern = xlNone
.Border.ColorIndex = 5
End With
Set Cell = .FindNext(Cell)
Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
End If
End With
End Sub
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
[Reference] See " Using an Existing VBA Method: Find Method" in the article "A Way to Make VBA Code Faster and More Concise " to experience using the traditional looping method and the The difference in VBA code speed when using this method to achieve the same function.
5.2 Example 2: Copy relevant data from one list to another list (Revised from Hansen's Programming)
The function of this program is to search in column B of cell range A1:D11 according to the value in cell I1, and each time Once the corresponding value is found, the row data of the range where the cell is located is copied to the range starting with cell G3 (the cell is named found). The original data is shown in Figure 03 below. 
Figure 03: Raw data
Click the "Find" button in the worksheet, and the result after running is shown in Figure 04 below. 
Figure 04: The resulting
source code list and related descriptions are as follows:
'- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Option Explicit
Sub FindSample2()
Dim ws As Worksheet
Dim rgSearchIn As Range
Dim rgFound As Range
Dim sFirstFound As String
Dim bContinue As Boolean
ReSetFoundList 'Initialize the list area to be copied
Set ws = ThisWorkbook.Worksheets("sheet1")
bContinue = True
Set rgSearchIn = GetSearchRange (ws) 'Get the search area
' set the search parameters
Set rgFound = rgSearchIn.Find(what:=ws.Range("I1").Value, _
LookIn:=xlValues, LookAt:=xlWhole)
'Get the address of the first cell that satisfies the condition as the condition to end the loop
If Not rgFound Is Nothing Then sFirstFound = rgFound.Address
Do Until rgFound Is Nothing Or Not bContinue
CopyItem rgFound
Set rgFound = rgSearchIn.FindNext(rgFound)
'Judgment loop Abort
If rgFound.Address = sFirstFound Then bContinue = False
Loop
Set rgSearchIn = Nothing
Set rgFound = Nothing
Set ws = Nothing
End Sub
'Get the search range, that is, the "part" cell range in column B
Private Function GetSearchRange(ws As Worksheet) As Range
Dim lLastRow As Long
lLastRow = ws.Cells(65536, 1).End(xlUp).Row
Set GetSearchRange = ws.Range(ws.Cells(1, 2), ws.Cells(lLastRow, 2))
End Function
'Copy the found data to the found area
Private Sub CopyItem(rgItem As Range)
Dim rgDestination As Range
Dim rgEntireItem As Range
'Get the entire row of data in the search area
Set rgEntireItem = rgItem.Offset(0, -1)
Set rgEntireItem = rgEntireItem.Resize(1, 4)
Set rgDestination = rgItem.Parent.Range("found")
'Locate the first line of the found area to be copied to
If IsEmpty(rgDestination.Offset(1, 0)) Then
Set rgDestination = rgDestination .Offset(1, 0)
Else
Set rgDestination = rgDestination.End(xlDown).Offset(1, 0)
End If
'Copy found data to found area
rgEntireItem.Copy rgDestination
Set rgDestination = Nothing
Set rgEntireItem = Nothing
End Sub
'初始化要复制到的区域(found区域)
Private Sub ReSetFoundList()
Dim ws As Worksheet
Dim lLastRow As Long
Dim rgTopLeft As Range
Dim rgBottomRight As Range
Set ws = ThisWorkbook.Worksheets("sheet1")
Set rgTopLeft = ws.Range("found").Offset(1, 0)
lLastRow = ws.Range("found").End(xlDown).Row
Set rgBottomRight = ws.Cells(lLastRow, rgTopLeft.Offset(0, 3).Column)
ws.Range(rgTopLeft, rgBottomRight).ClearContents
Set rgTopLeft = Nothing
Set rgBottomRight = Nothing
Set ws = Nothing
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
In the above program code, the program FindSample2( ) is the main program. First, the subroutine ReSetFoundList( ) is called to initialize the data area to be copied, that is, to clear the contents except the title row; then call the custom function GetSearchRange(ws As Worksheet) Get the cell range you are looking for; use the Find method and the FIndNext method in the main program to search, and call the subroutine CopyItem (rgItem As Range) with parameters to copy the data row where the cell is located to the corresponding range.
For example documents, see Find method example 1.xls. UploadFiles/2006-9/928354714.rar
5.3 Example 3: Realize the search with the condition of continuous cell range The
following code provides a method and idea to realize the search with the data in the continuous cell range as the search condition. In this example, the search criteria range is D2:D4, the search is performed in the cell range A1:A21, and the result is entered into the range starting with cell F2. The worksheet data and results corresponding to the sample program are shown in Figure 06 below.
'- - - - - - - - - - -Code Listing - - - - - - - - - - - - - - - - - - - - - -
Sub FindGroup()
Dim ToFind As Range, Found As Range, c As Range
Dim FirstAddress As String
Set ToFind = Range("D2:D4")
With Worksheets(1).Range("a1:a21")
Set c = .Find(ToFind(1), LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
If c.Offset(1) = ToFind(2) And c.Offset(2) = ToFind(3) Then
Set Found = Range(c.Offset(0, 1), c.Offset(0, 1).Offset(2))
GoTo Exits
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Exits:
Found.Copy Range("F2")
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
图05 数据及查找结果
By fanjy in 2006-9-28