Merhabalar, Aşağıdaki kod ile B sütununda yazılı uzunca bir listede aynı olan satırları siliyoruz.
Satırlarda yazılı olanlar aynı olsalar bile (Boşluk)-(CTRL+ENTER)-(ALT+ENTER)-(ve benzeri) gibi uygulamalar nedeniyle kullanılan hücrelerde diğer arama metotları pek işe yaramıyor.
Bu nedenle Hücrelerdeki bilgilerin boşlukları alınıyor, yazı karekterleri birbirlerine uyduruluyor ve space (Boşluk ve Ctrl+Enter) özellikleri kaldırılıyor. Aranan ve aranılan hücredeki bilgi bir yazı yumağı haline getiriliyor.
Sizlerden RİCAM unutulan bir karekter türü (ASCİİ kodu) daha varmıdır veya bunu yapmanın bilinen başka bir uygulaması varmıdır?
İlgilenen ve ilgilenecek tüm arkadaşlara şimdiden teşekkürler...
Private Sub MukerrerBul_Click()
'ARANAN SEÇİMİNE SONDAN BAŞLIYORUZ...BAŞA DOĞRU
For b = [b65536].End(xlUp).Row To 1 Step -1
DEG = Trim(Sheets("Sayfa1").Range("B" & b))
DEG = UCase(Replace(Replace(Replace(Replace(Replace(Repl ace(Replace(Replace(Replace(Replace(DEG, "İ", "i"), _
"Ç", "ç"), "Ö", "ö"), "Ü", "ü"), "Ş", "ş"), "Ğ", "ğ"), " ", ""), Chr(10), ""), Chr(13), ""), Chr(32), ""))
'ARAMAYI BAŞTAN ARANAN SATIRA KADAR YAPIYORUZ
For a = 1 To b
DEG1 = Trim(Sheets("Sayfa1").Range("B" & a))
DEG1 = UCase(Replace(Replace(Replace(Replace(Replace(Repl ace(Replace(Replace(Replace(Replace(DEG1, "İ", "i"), _
"Ç", "ç"), "Ö", "ö"), "Ü", "ü"), "Ş", "ş"), "Ğ", "ğ"), " ", ""), Chr(10), ""), Chr(13), ""), Chr(32), ""))
If a <> b And DEG = DEG1 Then
'MÜKERER SATIRI SİLİYORUZ.
Rows(a).Delete
'BİR SONRAKİ SATIRA GEÇİP ARANAN SATIRA KADAR DEVAM
b = b + 1
GoTo oldu
End If
Next a
oldu:
Next b
MsgBox "Mükerrer Kod Taraması Sona Ermiştir."
End Sub
NOT: Dosya ekleyin diyecek arkadaşların dikkatine... Kod Arşiv Programında bu sistem uygulanıyor zaten. Sağolun...
Satırlarda yazılı olanlar aynı olsalar bile (Boşluk)-(CTRL+ENTER)-(ALT+ENTER)-(ve benzeri) gibi uygulamalar nedeniyle kullanılan hücrelerde diğer arama metotları pek işe yaramıyor.
Bu nedenle Hücrelerdeki bilgilerin boşlukları alınıyor, yazı karekterleri birbirlerine uyduruluyor ve space (Boşluk ve Ctrl+Enter) özellikleri kaldırılıyor. Aranan ve aranılan hücredeki bilgi bir yazı yumağı haline getiriliyor.
Sizlerden RİCAM unutulan bir karekter türü (ASCİİ kodu) daha varmıdır veya bunu yapmanın bilinen başka bir uygulaması varmıdır?
İlgilenen ve ilgilenecek tüm arkadaşlara şimdiden teşekkürler...
Private Sub MukerrerBul_Click()
'ARANAN SEÇİMİNE SONDAN BAŞLIYORUZ...BAŞA DOĞRU
For b = [b65536].End(xlUp).Row To 1 Step -1
DEG = Trim(Sheets("Sayfa1").Range("B" & b))
DEG = UCase(Replace(Replace(Replace(Replace(Replace(Repl ace(Replace(Replace(Replace(Replace(DEG, "İ", "i"), _
"Ç", "ç"), "Ö", "ö"), "Ü", "ü"), "Ş", "ş"), "Ğ", "ğ"), " ", ""), Chr(10), ""), Chr(13), ""), Chr(32), ""))
'ARAMAYI BAŞTAN ARANAN SATIRA KADAR YAPIYORUZ
For a = 1 To b
DEG1 = Trim(Sheets("Sayfa1").Range("B" & a))
DEG1 = UCase(Replace(Replace(Replace(Replace(Replace(Repl ace(Replace(Replace(Replace(Replace(DEG1, "İ", "i"), _
"Ç", "ç"), "Ö", "ö"), "Ü", "ü"), "Ş", "ş"), "Ğ", "ğ"), " ", ""), Chr(10), ""), Chr(13), ""), Chr(32), ""))
If a <> b And DEG = DEG1 Then
'MÜKERER SATIRI SİLİYORUZ.
Rows(a).Delete
'BİR SONRAKİ SATIRA GEÇİP ARANAN SATIRA KADAR DEVAM
b = b + 1
GoTo oldu
End If
Next a
oldu:
Next b
MsgBox "Mükerrer Kod Taraması Sona Ermiştir."
End Sub
NOT: Dosya ekleyin diyecek arkadaşların dikkatine... Kod Arşiv Programında bu sistem uygulanıyor zaten. Sağolun...
Son düzenleme:
