Soru Abone No'ları Karşılaştırma

[okan32]

SAYFA2 DEKİ ABONE NOLAR İLE SAYFA1 DEKİ ABONE NOLAR KARŞILAŞTIRILARAK SAYFA1 DEKİ FARKLI OLANLARIN KIRMIZI AYNI OLANLARIN İSE YEŞİL OLMASINI İSTİYORUM. EĞER HÜCRE BOŞ İSE BEYAZ OLSUN.YARDIMLARINIZ İÇİN ŞİMDİDEN TEŞEKKÜR EDERİM.

 

[EmrExcel16]

Okan bey , sorularınızın tamaminda büyük harf kullanmayıniz (Forum kuralları). Karşılaştırmadaki kastınız nedir , S1' de olup S2'de olmayanlar kırmızi olanlar yeşil mi olmasını istiyorsunuz , tam olarak anlamadım.

 

[genesis_vision]

Deneyiniz.
Uyarı: Dosyanızda aynı sütundaki verilerin bazıları metin, bazıları sayı, bazıları da isteğe göre uyarlanmış verilerden oluşuyor. Bu şekilde kod istenildiği çalışmayabilir. Yüklediğim dosyada bu durumu düzelttim. Gerçek dosyanızda siz de değiştirin.

Sub karsilastir()
Dim sht1, sht2 As Worksheet
Set sht1 = Sheets("Sayfa1"): Set sht2 = Sheets("Sayfa2")
Dim str1, str2 As Long
str1 = sht1.Cells(Rows.Count, 4).End(3).Row
str2 = sht2.Cells(Rows.Count, 2).End(3).Row
Dim c, rng1, rng2 As Range
Set rng1 = sht1.Range("d4:d" & str1): Set rng2 = sht2.Range("b3:b" & str2)
Dim a As Boolean

For Each c In rng1
    a = Application.CountIf(rng2, c) >= 1
        
    If IsEmpty(c) = True Then
        c.Interior.Color = xlNone
    ElseIf a = True Then
        c.Interior.Color = vbGreen
    ElseIf a = False Then
        c.Interior.Color = vbRed
    End If
Next
MsgBox "İşlem tamam!", vbInformation
End Sub

 

[okan32]

Teşekkürler arkadaşlar pazartesi deneyeceğim

 

[EmrExcel16]

Eğer o şekilde ise , aşağıdaki kodlar ile yapabilirsiniz..

Sub Test()
Application.ScreenUpdating = False
For i = 5 To Cells(Rows.Count, 4).End(3).Row
    If Cells(i, 4) = "" Then Cells(i, 4).Interior.Color = xlNone: GoTo 10
    Set bul = Sheets("Sayfa2").Range("B2:B100000").Find(Cells(i, 4), , xlValues, xlWhole)    
    If Not bul Is Nothing Then Cells(i, 4).Interior.Color = vbGreen
    If bul Is Nothing Then Cells(i, 4).Interior.Color = vbRed
10
Next
Application.ScreenUpdating = True
MsgBox "Islem tamam..."
End Sub

 

[okan32]

Teşekkür ederim EmrExcel16 pazartesi deneyeceğim