Temukan sel dengan nilai tertentu di excel vba

Temukan adalah opsi yang sangat kuat di Excel dan sangat berguna. Bersama dengan fungsi Offset Anda juga dapat mengubah sel di sekitar sel yang ditemukan. Di bawah ini adalah beberapa contoh dasar yang dapat Anda gunakan dalam kode Anda sendiri

Gunakan Temukan untuk memilih sel

Contoh di bawah ini akan mencari di kolom A dari lembar bernama "Sheet1" untuk nilai kotak input. Ubah nama sheet atau rentang dalam kode ke sheet/rentang Anda

Tip. Anda dapat mengganti kotak input dengan string atau referensi ke sel seperti ini
FindString = "SearchWord"
Atau
FindString = Lembar("Lembar1"). Rentang("D1"). Nilai

Contoh ini akan memilih sel pertama dalam rentang dengan nilai 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

Jika Anda memiliki lebih dari satu kemunculan nilai, ini akan memilih kemunculan terakhir

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

Jika Anda memiliki tanggal di kolom A maka contoh ini akan memilih sel dengan tanggal hari ini. Catatan. Jika tanggal Anda adalah rumus, Anda mungkin harus mengubah xlFormulas menjadi xlValues ​​dalam contoh di bawah ini. Jika tanggal Anda adalah nilai, xlValues ​​tidak selalu berfungsi dengan beberapa format tanggal

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

Tandai sel dengan nilai yang sama di kolom A di kolom B

Contoh ini mencari di Lembar ("Sheet1") di kolom A untuk setiap sel dengan "ron" dan gunakan Offset untuk menandai sel di kolom sebelah kanan. Catatan. Anda dapat menambahkan lebih banyak nilai ke array 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

Warnai sel dengan nilai yang sama di Rentang, lembar kerja, atau semua lembar kerja

Contoh ini mewarnai semua sel dalam rentang Sheets("Sheet1"). Rentang("B1. D100") dengan "ron". Lihat komentar di kode jika Anda ingin menggunakan semua sel di lembar kerja. Saya menggunakan indeks warna dalam contoh ini untuk memberi semua sel dengan "ron" warna 3 (normal ini berwarna merah)

Lihat situs ini untuk semua 56 nomor indeks
http. //dmcritchie. mvps. org/excel/warna. htm

Tip. Untuk mengubah warna Font lihat contoh baris di bawah makro

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

Contoh untuk semua lembar kerja di buku kerja

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

Ubah warna Font alih-alih warna Interior

Mengganti

'Ubah warna isian menjadi "tanpa isian" di semua sel
Pedalaman. ColorIndex = xlColorIndexNone

Dengan

'Ubah font di kolom ke Otomatis
Fon. ColorIndex = 0

Dan Ganti

Rng. Pedalaman. ColorIndex = Warnaku(I)
Dengan
Rng. Fon. ColorIndex = Warnaku(I)

Salin sel ke lembar lain dengan Temukan

Contoh di bawah ini akan menyalin semua sel dengan Alamat E-Mail dalam rentang Sheets("Sheet1"). Rentang("A1. E100") ke lembar kerja baru di buku kerja Anda. Catatan. Saya menggunakan xlPart dalam kode alih-alih xlWhole untuk menemukan setiap sel dengan karakter @

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

Informasi Lebih Lanjut

Jika Anda hanya ingin mengganti nilai di lembar kerja Anda, Anda dapat menggunakan Ganti manual (Ctrl+h) atau gunakan Ganti di VBA. Kode di bawah ganti ron untuk dave di seluruh lembar kerja. Ubah xlPart menjadi xlWhole jika Anda hanya ingin mengganti sel dengan ron saja

Bagaimana cara menemukan sel yang berisi teks tertentu di Excel VBA?

Bagaimana cara menemukan nilai tertentu dalam sel di Excel?

Bagaimana cara mereferensikan sel tertentu di VBA?