2 Sütun arasında aynı olan verileri ayırt etmek

[VahapZTL]

Merhaba arkadaşlar, elimde excel dosyası var bu dosyada a ve b sütunlarındaki verilerin kontrol edilmesi gerek. Kontrol de şu a ve b sütunundaki veriler birebir aynıysa a sütunundaki verinin başına $$$ koyulup arka planının kırmızıya boyanması. Dosya üzerinde işlem yapmak isterseniz dosyayıda yükleyebilirim şimdiden teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

-- Belgeniz açıkken ALT+F11 tuşlarına basın ve VBA ekranının görüntülenmesini sağlayın,
-- VBA ekranında üst taraftaki menüde INSERT => MODULE 'yi seçin,
-- Ekranın sağ tarafındaki boş alana aşağıdaki kod'u yapıştırın,
-- Excel sayfasına (sayfa adının Sheet1 olduğunu varsaydım) bir adet DÜĞME/ŞEKİL/METİN KUTUSU ekleyin,
-- Eklediğiniz DÜĞME/ŞEKİL/METİNİ KUTUSU'na fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılan küçük ekranda KARŞILAŞTIR_BOYA'yı seçip işlemi onaylayın.
-- Sayfadaki DÜĞME/ŞEKİL/METİN KUTUSUna fareyle tıkladığınızda istediğiniz işlem gerçekleşecektir.
.

[FONT="Arial Narrow"][B]Sub KARŞILAŞTIR_BOYA()[/B]
Set s1 = Sheets("[B][COLOR="Blue"]Sheet1[/COLOR][/B]"): Set wf = Application.WorksheetFunction
Amak = s1.[A65536].End(3).Row: Bmak = s1.[B65536].End(3).Row
For satır = [B][COLOR="Red"]1[/COLOR][/B] To wf.Max(Amak, Bmak)
[COLOR="red"]If Cells(satır, 1).HasFormula Or Cells(satır, 2).HasFormula Then GoTo 10[/COLOR]
    If s1.Cells(satır, 1) <> "" And s1.Cells(satır, 2) <> "" _
        And s1.Cells(satır, 1) = s1.Cells(satır, 2) Then
        s1.Cells(satır, 1) = "$$$" & s1.Cells(satır, 1)
        s1.Cells(satır, 1).Interior.Color = vbRed
    End If
[B][COLOR="Red"]10: [/COLOR][/B]Next
[B]End Sub[/B][/FONT]

 

[tahsinanarat]

Dosyanız ekte

a ve b sutunlarını karşılaştırıp önce aynı olanları a sutununda kırmızıya boyar, sonra aynı olanların başına $$$ koyar,

Not: Ömer hocamın cevabını ben cevap verdikten sonra gördüm, altarnadif olsun.

 

[tahsinanarat]

Sn. Ömer hocam, sizin kodları da arşivime almak amaçlı kotrol ettiğimde, a ve b sutunundaki aynı olanlar aynı satıra denk geliyorsa istenileni yapıyor, aynı olanlar farklı satırlarda ise aynı işlemi yapması için kodda nasıl bir değişiklik olmalıdır, şimdiden teşekkür ederim.

 

[VahapZTL]

Hocam bu şekilde bir hata alıyorum ve bazı satırları yapmadan geçmiş.

 

[Ömer BARAN]

Tekrar merhaba.

İsterseniz, sorunuzu örnek belge ile destekleyin.
Örnek belge özellikleri ve yükleme yöntemi cevaplarımın altındaki İMZA bölümünde var.

 

[Erkan Akayay]

Sub renklendir()
Dim alan As Range
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To Range("B65536").End(3).Row
dic.Add Cells(i, 2).Value, i - 1
Next

For Each alan In Range("A2:A" & Range("A65536").End(3).Row)
If dic.exists(alan.Value) = True Then
alan.Value = "$$$" & alan.Value
alan.Interior.Color = vbRed
End If
Next
End Sub

http://dosya.co/6jza5522a5nu/renklendir.rar.html

 

[VahapZTL]

Redux.xlsx - 2.4 MB
Dosya bu hocam.

 

[Ömer BARAN]

Tekrar merhaba.

Önceki cevabımı güncelledim, sayfayı yenileyerek kontrol ediniz.
.

 

[VahapZTL]

Hocam çok sağolun oldu.