• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aynı hücredeki tekrarlı kelimeleri boyama

N

nanotech3485

Katılım
2 Mayıs 2021
Mesajlar
56
Excel Vers. ve Dili
Excel 2016 - TR
Arkadaşlar merhaba, elimde 1 yıldan fazla bir süredir kullandığım bir makro var. Ama çok ağır çalışıyor. A sütununda binlerce satır veri var ve makro her bir hücrede aynı kelime iki veya daha fazla geçiyorsa ilgili satırı sarı renge boyuyor.

Örneğin;

ABC Döner Kartal, Kartal, İstanbul
Ali Motor Defne, Hatay
Akyüz Deneme, DENEME
...

1. ve 3. satırda aynı kelimeden geçtiği için 1. ve 3. satırı sarı renge boyuyor.

Şu an kullandığım dosya ektedir. En az 10 binlerce satır veri ile uğraşıyorum. Eğer çok daha hızlısı yapılabilirse çok memnun olacağım. Ayrıca işlem devam ederken ProgressBar ile işlemin % kaçının yapıldığını da görebilirsem mükemmel olacaktır. Teşekkür ederim.
 

Ekli dosyalar

C#: 
Sub Test()
    Dim i As Integer, NoA As Integer, myArr() As String, iCount As Integer
    
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:A" & NoA).Interior.ColorIndex = 0
    
    For i = 1 To NoA
        myStr = LCase(Replace(Replace(Range("A" & i), ",", ""), ".", ""))
        myArr = Split(myStr)
        sCount = 0
        
        For x = LBound(myArr) To UBound(myArr)
            iCount = UBound(Split(myStr, myArr(x))) + 1
            If iCount > 2 Then
                Range("A" & i).Interior.ColorIndex = 6
                Exit For
            End If
        Next
    Next
End Sub

.
 
Haluk' Alıntı:
C#: 
Sub Test()
    Dim i As Integer, NoA As Integer, myArr() As String, iCount As Integer
   
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:A" & NoA).Interior.ColorIndex = 0
   
    For i = 1 To NoA
        myStr = LCase(Replace(Replace(Range("A" & i), ",", ""), ".", ""))
        myArr = Split(myStr)
        sCount = 0
       
        For x = LBound(myArr) To UBound(myArr)
            iCount = UBound(Split(myStr, myArr(x))) + 1
            If iCount > 2 Then
                Range("A" & i).Interior.ColorIndex = 6
                Exit For
            End If
        Next
    Next
End Sub

.
Genişletmek için tıkla ...


Hocam kodu ekledim bazı satırları sarıya boyadı ama boyadığı satırlarda tekrarlı kelimeler maalesef yok. Ama çok hızlı çalıştı. Ben test datasını içeren dosyayı ekledim. Bakma şansınız var mıdır?
 

Ekli dosyalar

C#: 
Sub Test()
    Dim i As Long, NoA As Long, myArr() As String, x As Integer, iCount As Long, xWord As Variant
    
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:A" & NoA).Interior.ColorIndex = 0
    
    For i = 1 To NoA
        myStr = LCase(Replace(Replace(Range("A" & i), ",", ""), ".", ""))
        myArr = Split(myStr)
        
        For x = LBound(myArr) To UBound(myArr)
            iCount = 0
            For Each xWord In myArr
                If xWord = myArr(x) Then
                    iCount = iCount + 1
                    If iCount >= 2 Then
                        Range("A" & i).Interior.ColorIndex = 6
                        Exit For
                    End If
                End If
            Next
        Next
    Next
End Sub

.
 
Haluk' Alıntı:
C#: 
Sub Test()
    Dim i As Long, NoA As Long, myArr() As String, x As Integer, iCount As Long, xWord As Variant
   
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:A" & NoA).Interior.ColorIndex = 0
   
    For i = 1 To NoA
        myStr = LCase(Replace(Replace(Range("A" & i), ",", ""), ".", ""))
        myArr = Split(myStr)
       
        For x = LBound(myArr) To UBound(myArr)
            iCount = 0
            For Each xWord In myArr
                If xWord = myArr(x) Then
                    iCount = iCount + 1
                    If iCount >= 2 Then
                        Range("A" & i).Interior.ColorIndex = 6
                        Exit For
                    End If
                End If
            Next
        Next
    Next
End Sub

.
Genişletmek için tıkla ...


Haluk Bey çok teşekkürler kod çalışıyor ve inanılmaz hızlı. 10 bin veriyi 2 saniye de analiz etti :) Bu kadarını da beklemiyordum açıkçası. Hocam testimi yaptım. Türkçe büyük karakterlerde tekrarlı kelimeleri bulamadı.

Örneğin;

ABC Döner Şanlıurfa, ŞANLIURFA
Deneme Firması pendik, PENDİK

Galiba küçük ı ile büyük I aynı satırda olunca bulamıyor. Ayrıca şanlıurfa şeklinde yazarsam buluyor.
Deneme Firması pendik, PENDİK ise bu şekilde sarıya boyamadı. İ den dolayı olsa gerek. Kontrol edebilmeniz mümkün müdür acaba? Teşekkürler
 
Aşağıdaki satırı;
C#: 
        myStr = LCase(Replace(Replace(Range("A" & i), ",", ""), ".", ""))



bununla değiştirin;
C#: 
        myStr = LCase(Replace(Replace(Replace(Replace(Range("A" & i), "ı", "I"), "İ", "i"), ",", ""), ".", ""))

.
 
Merhaba,

Benzer bir soruyu cevapladığımı hatırlıyordum. Aradım buldum. Yine siz sormuşsunuz.

Satır içi aynı kelimeden birden fazla geçmesi

Arkadaşlar merhaba; Elimde 1 sütun da binlerce satır firma adı bilgisi var. Bazı satırlarda firma adında birden fazla aynı kelime veya kelimeler geçebiliyor. Acaba aynı satırda bir kelimeden birden fazla geçen satırları farklı bir renk ile belirtebilir miyiz? Günlük bazı çalışmalarım var manuel...
www.excel.web.tr www.excel.web.tr
 
Haluk' Alıntı:
Aşağıdaki satırı;
C#: 
        myStr = LCase(Replace(Replace(Range("A" & i), ",", ""), ".", ""))



bununla değiştirin;
C#: 
        myStr = LCase(Replace(Replace(Replace(Replace(Range("A" & i), "ı", "I"), "İ", "i"), ",", ""), ".", ""))

.
Genişletmek için tıkla ...


Haluk Bey çok teşekkür ederim. Sorun düzeldi. Hocam son olarak bayağı bir veride denedim. Satırda iki adet & veya / gibi özel karakterler geçiyorsa o satırı da boyuyor. Bu tarz özel karakterleri devre dışı bırakmak için hangi kodu eklemeliyim.
 
Korhan Ayhan' Alıntı:
Merhaba,

Benzer bir soruyu cevapladığımı hatırlıyordum. Aradım buldum. Yine siz sormuşsunuz.

Satır içi aynı kelimeden birden fazla geçmesi

Arkadaşlar merhaba; Elimde 1 sütun da binlerce satır firma adı bilgisi var. Bazı satırlarda firma adında birden fazla aynı kelime veya kelimeler geçebiliyor. Acaba aynı satırda bir kelimeden birden fazla geçen satırları farklı bir renk ile belirtebilir miyiz? Günlük bazı çalışmalarım var manuel...
www.excel.web.tr www.excel.web.tr
Genişletmek için tıkla ...

Merhaba Korhan Bey, evet geçen sene böyle bir soru sordum ama sizin mesajınızı görmemiştim. Sizden önce yazan arkadaşın kodunu kullanıyordum yaklaşık 60k veriyi kontrol etmesi 10 saatten fazla sürüyordu. Sizin kodunuzu görmediğim için deneme imkanım olmadı. Çok teşekkür ederim.
 
Hücrede 2 aynı tek karakter varsa, eşleştirme olmadığını Excel'e tarif etmek için, aşağıdaki satırı;
C#: 
                If xWord = myArr(x) Then


bununla değiştirin;
Kod: 
                If xWord = myArr(x) And Len(xWord) > 1 Then

.
 
Korhan abinin verdiği linkte verdiği çözüme aynı anda teşekkür etmişsiniz, cevabı görmemiş olmanız olanaklı değil, sanırım gözden kaçtı.
 
Haluk' Alıntı:
Hücrede 2 aynı tek karakter varsa, eşleştirme olmadığını Excel'e tarif etmek için, aşağıdaki satırı;
C#: 
                If xWord = myArr(x) Then


bununla değiştirin;
Kod: 
                If xWord = myArr(x) And Len(xWord) > 1 Then

.
Genişletmek için tıkla ...

Hocam çok teşekkürler. Elinize sağlık deneyip haber vereceğim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst