B sütunundakileri A sütununda bulma

gunay.harun

Altın Üye
Katılım
25 Şubat 2016
Mesajlar
62
Excel Vers. ve Dili
Excel 2016 türkçe
Altın Üyelik Bitiş Tarihi
09-10-2024
Her satırı kendi içinde değerlendirmiştim. Siz B sütunundaki tüm verilerin A sütununda her satırda aranmasını istiyorsunuz.

Aşağıdaki kodu deneyebilirsiniz.

C++:
Option Explicit

Sub Color_Search_Data()
    Dim Rng As Range, All_Find_Text As Object, X As Long
    Dim My_Data As Variant, Find_Text As Object
    Dim Pattern_Array As Object, My_Pattern As Variant

    Application.ScreenUpdating = False

    Range("A:A").Font.Bold = False
    Range("A:A").Font.Color = False

    My_Data = Range("B1:B" & Cells(Rows.Count, 2).End(3).Row).Value

    Set Pattern_Array = VBA.CreateObject("Scripting.Dictionary")
   
    For X = LBound(My_Data) To UBound(My_Data)
        If My_Data(X, 1) <> "" Then
            Pattern_Array.Add My_Data(X, 1), False
        End If
    Next
   
    With VBA.CreateObject("VBScript.RegExp")
        For Each Rng In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
            For Each My_Pattern In Pattern_Array.Keys
                .Pattern = "( " & My_Pattern & " )"
                .Global = True
           
                Set All_Find_Text = .Execute(" " & Rng.Value & " ")
           
                For Each Find_Text In All_Find_Text
                    Rng.Characters(Find_Text.FirstIndex, Find_Text.Length - IIf(Find_Text.FirstIndex = 0, 2, 0)).Font.Bold = True
                    Rng.Characters(Find_Text.FirstIndex, Find_Text.Length - IIf(Find_Text.FirstIndex = 0, 2, 0)).Font.Color = vbRed
                Next
            Next
        Next
    End With
   
    Erase My_Data
    Pattern_Array.RemoveAll
   
    Set Pattern_Array = Nothing
   
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Korhan hocam elinize sağlık işimi gördü. Çok tesekkurederim
 

gunay.harun

Altın Üye
Katılım
25 Şubat 2016
Mesajlar
62
Excel Vers. ve Dili
Excel 2016 türkçe
Altın Üyelik Bitiş Tarihi
09-10-2024
850 satır demek en az 850*850 kez işlem yapmak demektir ki çoğunda daha fazla işlem yapılır. Bu da exceli çok yorar elbette. Dosyanızda formülle ve bağlantılar varsa iş yükü daha da artar.

Korhan Bey'in makrosunu deneyin, belki o daha hızlı ve verimli olabilir.
Yusuf hocam teşekkürler sizde baya ugrastiniz
 
Üst