Forum

Kısmen ya da Tamame...
 
Bildirimler
Hepsini Temizle

Kısmen ya da Tamamen Benzer Verileri Tespit Etme

4 Yazılar
3 Üyeler
0 Likes
439 Görüntüleme
(@Anonim)
Gönderiler: 0
Konu başlatıcı
 

Yazım yanlışlarından ötürü birbirinden farklı olan hücrelerdeki verilerden, kısmen ya da tamamen benzer olan hücreleri tespit etmek için kullanılabilir..

Özellikle şu zamanlarda [b]E-fatura[/b] müşterilerini maliye sitesinden alıp, kendi carileri ile karşılaştırmak isteyen [b]Excel[/b] kullanıcılarının oldukça işine yarayacağı bir çalışma.. 

Faydalı olması dileğiyle.. --)( 

■ [b]Module içerisine;[/b]

Option Compare Text
DefObj A
-B, R-S
DefInt C
, I
Sub Hücreleri_Karşılaştır
()
    Dim Evn As Range, Mrt As Range
    Set Reg 
= CreateObject("VBScript.RegExp")
    Set Rky = CreateObject("VBScript.RegExp")
    Columns("C:E").Clear
    Rky
.Global = True: Rky.IgnoreCase = True
    Reg
.Global = True: Reg.IgnoreCase = True
    Rky
.Pattern = "[0-9a-z\s\ç\Ç\ö\Ö\ş\Ş\ı\İ\ğ\Ğ\ü\Ü]{3,}"
    Reg.Pattern = "[0-9a-z\s\ç\Ç\ö\Ö\ş\Ş\ı\İ\ğ\Ğ\ü\Ü]{3,}"
    For i = 1 To Range("A65536").End(3).Row
        Set say 
= Reg.Execute(Cells(i, 1))
        Set soy = Rky.Execute(Cells(i, 2))
        If say.Count > 0 Then Cells(i, 3) = Reg.Execute(Cells(i, 1)).Item(0)
        If soy.Count > 0 Then Cells(i, 4) = Rky.Execute(Cells(i, 2)).Item(0)
        For Each ara In say
            For Each bul In soy
                For C 
= 1 To bul.Length
                    If Mid
(ara, 1, C) = Mid(bul, 1, C) Then
                        Set Evn 
= Columns(3).Find(ara, , , 2)
                        If Not Evn Is Nothing Then
                            dali 
= Evn.Address
                            Do
                            Set Evn 
= Columns(3).FindNext(Evn)
                            Evn.Offset(0, 2).Value = "DOĞRU"
                            Evn.Offset(0, 2).Font.ColorIndex = 45
                            Loop While Not Evn Is Nothing And dali 
<> Evn.Address
                        End If
                    ElseIf Right
(Mid(ara, 1, C), 3) = Right(Mid(bul, 1, C), 3) Then
                        Set Mrt 
= Columns(3).Find(ara, , , 2)
                        If Not Mrt Is Nothing Then
                            dali 
= Mrt.Address
                            Do
                            Set Mrt 
= Columns(3).FindNext(Mrt)
                            Mrt.Offset(0, 2).Value = "DOĞRU"
                            Mrt.Offset(0, 2).Font.ColorIndex = 45
                            Loop While Not Mrt Is Nothing And dali 
<> Mrt.Address
                        End If
                    Else
                    End If
                Next C
            Next bul
        Next ara
        If Cells
(i, 5) = "" Then Cells(i, 5) = "YANLIŞ": Cells(i, 5).Font.ColorIndex = 3
    Next i
    Columns
.AutoFit
    Set Reg 
= Nothing: Set Rky = Nothing: Set Evn = Nothing: Set Mrt = Nothing: C = Empty
    Set ara 
= Nothing: Set bul = Nothing: Set say = Nothing: Set soy = Nothing: i = Empty:
End Sub

Örnek Excel Sayfa görüntüsü; 
[img] [/img]

Not: Kodlar sütunu ile sütununu karşılaştırır. Sizin karşılaştırmak istediğiniz sütunlar farklı ise koddaki ilgili yerleri değiştirmeniz gerek. Verileriniz ve sütunlarında olursa sorunsuz bir şekilde karşılaştırıp sonuç alabilirsiniz.

Hoşça kalın ! --)(

 
Gönderildi : 11/12/2013 22:07

(@ibrahimDOGAN)
Gönderiler: 261
Reputable Member
 

Eline Sağlık. Birçok arkadaşımızın işine yarayacak bir paylaşım

 
Gönderildi : 12/12/2013 13:55

(@Anonim)
Gönderiler: 0
Konu başlatıcı
 

Evet İbrahim BeyExcel'de bu tarz bir çalışma yapılmadığını fark ettim ve böyle bir çalışmanın faydalı olabileceğini düşündüm, hele ki bu zamanda. 

Saygılar

 
Gönderildi : 12/12/2013 15:00

(@mr.casus)
Gönderiler: 1
New Member
 

merhaba,

Öncelikle ellerinize sağlık güzel bi makro oluş. yukarda gösterdiğiniz makroyu alarak elimdeki veriye uygulamadım ama soru çözemedim mail adresiniz varsa dosya gönderip inceleyebilir misiniz?

 
Gönderildi : 10/07/2017 18:08

Paylaş: