Ekstre Karşılaştırma ve Mutabakat

[ERMAN SAYINALP]

Merhaba,

Tarih, Borç ve Alacak Sütunlarından oluşan 2 Ekstre Karşılaştırması yapılarak FARKLI olan tutarların tespit edilmesi ve renklendirilmesinin yapılmasına yönelik talebimi değerlendirmelerinize sunarım.

Bu talebe ilişkin ÖRNEK Dosyayı ilişkte gönderiyorum.

Saygılarımla.

 

[çıtır]

1) B4 Hücresinde ad tanımlama sekmesine B4:B4000 yazıp enter yapınız.(B4:B40000 seçiniz.)
2) Giriş sekmesinde koşullu biçimlendirme seçeneklerinden.Yeni kural seçiniz.
3)Seçeneklerden Biçimlendirileçek hücreleri belirlemek için formül kullan seçiniz.
4)Bu formül doğru olduğunda değerleri biçimlendir alanınındaki formül alanına aşağıdaki 1.Formülü kopyalayınız.
5) Biçimlendir seçiniz.Dolgu seçiniz ve dolgu rengi belirleyiniz.Tamam
Aynı işlemleri F4 Hücresinde de yapınız ve formül alanına 2.Formülü kopyalayınız.
1.Formül

=VE($B4<>"";ÇOKEĞERSAY($E$4:$E$4000;$A4;$F$4:$F$4000;$B4)=0)

2.Formül

=VE($F4<>"";ÇOKEĞERSAY($A$4:$A$4000;$E4;$B$4:$B$4000;$F4)=0)

Dosyanız.

 

[halit3]

Alternatif kod:

Sub deneme1()


son1 = Cells(Rows.Count, "a").End(3).Row
son2 = Cells(Rows.Count, "e").End(3).Row

Range("B4:C" & son1).Interior.ColorIndex = 6
Range("f4:g" & son2).Interior.ColorIndex = 6
If son1 < son2 Then son1 = son2
ReDim ara1(son1): ReDim ara2(son1):
For j = 4 To son1
If Cells(j, "B").Value <> "" Then
ara1(j) = Cells(j, "a").Value & Cells(j, "b").Value
Else
ara1(j) = Cells(j, "a").Value & Cells(j, "c").Value
End If
ara2(j) = 1
Next j

sut = 2
For r = 4 To son1
If Cells(r, "f").Value <> "" Then
aranan1 = Cells(r, "e").Value & Cells(r, "f").Value
Else
aranan1 = Cells(r, "e").Value & Cells(r, "g").Value
End If
If ara2(r) = 1 Then
For i = 4 To son1
If ara1(i) = aranan1 Then

Cells(i, "b").Interior.ColorIndex = xlNone
Cells(i, "c").Interior.ColorIndex = xlNone

Cells(r, "f").Interior.ColorIndex = xlNone
Cells(r, "g").Interior.ColorIndex = xlNone
ara2(i) = 0
End If
Next i

End If
Next r



For r = 4 To Cells(Rows.Count, "A").End(3).Row
If Cells(r, "B").Interior.ColorIndex = 6 Then
aranan1 = Cells(r, "B").Value & Cells(r, "C").Value

For i = 4 To Cells(Rows.Count, "e").End(3).Row
If Cells(i, "f").Interior.ColorIndex = 6 Then
bulunan1 = Cells(i, "f").Value & Cells(i, "g").Value
If bulunan1 = aranan1 Then
Cells(i, "f").Interior.ColorIndex = xlNone
Cells(i, "g").Interior.ColorIndex = xlNone

Cells(r, "b").Interior.ColorIndex = xlNone
Cells(r, "c").Interior.ColorIndex = xlNone
Exit For
End If
End If
Next i
End If
Next r


End Sub

 

[ERMAN SAYINALP]

Merhabalar,

Rumuz'unuz nedeniyle nasıl hitap edeceğimi bilemedim. Emeğinize, elinize sağlık.
Çok teşekkür ederim.

 

[ERMAN SAYINALP]

Halit bey,

Emeğinize ve elinize sağlık.

Çok teşekkür ederim.

 

[ERMAN SAYINALP]

Özür dilerim ! HATA oldu

 

[halit3]

Teşekkürler iyi çalışmalar