Acil Yardım Karşılaştırma

[CihanTurK]

Liste Karşılaştırması

Hepinize iyi günler,

ben karışık iki listeyi karşılaştırmak istiyorum.
İstediklerim.

-Uçuş kodları ve ürün kodları karışık şekilde girildi. Bunlar birebir tutması lazım.

Tutanları ayrı renk, tutmayanlar ayrı renk olacak şekilde ve tutmayanların arasındaki farklarıda gösterecek bir özet tablo. Farklı ürün kodu veya uçus kodu varsada buda farklı renkte gösterilmesini rica ediyorum.

Yardımcı olursanız sevinirim...

sayfa1 ve sayfa2 olarak excel dosyası ektedir.
Bugün yetişirse bugün yoksa p.tesi. olursa sevinirim.

 

[asi_kral]

Merhaba
1 - Konu başlığını form kurallarına uymuyor. ( değiştirmezseniz yorum yapamam ve çözüm veremem )
2 - Her iki sayfada da bu işlemi istiyor musunuz_?
3 - 2 farklı renk mi kullanılacak 1 - Aynı olan 2 - farklı olan

 

[CihanTurK]

Merhaba
1 - Konu başlığını form kurallarına uymuyor. ( değiştirmezseniz yorum yapamam ve çözüm veremem )
2 - Her iki sayfada da bu işlemi istiyor musunuz_?
3 - 2 farklı renk mi kullanılacak 1 - Aynı olan 2 - farklı olan

sayfa1 ile sayfa2 deki veriler karşılaştırılacak.

Sayfa1deki uçuş kodu ile sayfa2deki uçuş kodu aynı olanlar birbiri ile tutması lazım. Eğer tutarsa örneğin sarı renk. tutmazsa kırmızı renk. ayrıca miktarları arasında eksik yada fazla çıkarsa onlarda ayrı bir yerde farkları çıksın. 3. sayfada olabilir.

Bunun dışında farklı uçuş kodu ve ürün kodu varsa onlarda ayrı bir renkte olsun.

şimdiden teşekkürler.

 

[asi_kral]

Merhaba
Bu kodu bir deneyin. Eksik kalan yerleri bildirirseniz ona göre yeniden düzenliyelim.

Option Explicit
Sub boyama()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR As Long, STN As Long, STR1 As Long
Dim ARASTR As Long, ARASTN As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")
Application.ScreenUpdating = False
S1.Range("A7:IV" & Rows.Count).Interior.ColorIndex = xlNone
S2.Range("A7:IV" & Rows.Count).Interior.ColorIndex = xlNone
S1.Range("B5:IV5").Interior.ColorIndex = xlNone
S2.Range("C5:IV5").Interior.ColorIndex = xlNone
With WorksheetFunction
For STR = 7 To S1.Cells(Rows.Count, "A").End(xlUp).Row
ARASTR = 0: ARASTN = 0
For STN = 2 To S1.Cells(5, Columns.Count).End(xlToLeft).Column
If .CountIf(S2.Range("B:B"), S1.Cells(STR, "A").Value) > 0 Then
ARASTR = .Match(S1.Cells(STR, "A"), S2.Range("B:B"), 0)
Else
S1.Cells(STR, "A").Interior.Color = vbGreen
End If
If .CountIf(S2.Rows(5), S1.Cells(5, STN)) > 0 Then
ARASTN = .Match(S1.Cells(5, STN), S2.Rows(5), 0)
Else
S1.Cells(5, STN).Interior.Color = vbGreen
End If
If ARASTR <> Empty And ARASTN <> Empty Then
If S1.Cells(STR, STN) = S2.Cells(ARASTR, ARASTN) Then
S1.Cells(STR, STN).Interior.Color = vbBlue
S2.Cells(ARASTR, ARASTN).Interior.Color = vbBlue
Else
S1.Cells(STR, STN).Interior.Color = vbRed
S2.Cells(ARASTR, ARASTN).Interior.Color = vbRed
End If: End If
Next: Next
End With
For STR = 7 To S2.Cells(Rows.Count, "B").End(xlUp).Row
If S2.Cells(STR, "B").Interior.ColorIndex <> xlNone Then
S2.Cells(STR, "B").Interior.Color = vbGreen
End If: Next
For STN = 3 To S2.Cells(5, Columns.Count).End(xlToLeft).Column
If S2.Cells(5, STN).Interior.ColorIndex <> xlNone Then
S1.Cells(5, STN).Interior.Color = vbGreen
End If: Next
Application.ScreenUpdating = True
End Sub

 

[CihanTurK]

Merhaba
Bu kodu bir deneyin. Eksik kalan yerleri bildirirseniz ona göre yeniden düzenliyelim.

Option Explicit
Sub boyama()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR As Long, STN As Long, STR1 As Long
Dim ARASTR As Long, ARASTN As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")
Application.ScreenUpdating = False
S1.Range("A7:IV" & Rows.Count).Interior.ColorIndex = xlNone
S2.Range("A7:IV" & Rows.Count).Interior.ColorIndex = xlNone
S1.Range("B5:IV5").Interior.ColorIndex = xlNone
S2.Range("C5:IV5").Interior.ColorIndex = xlNone
With WorksheetFunction
For STR = 7 To S1.Cells(Rows.Count, "A").End(xlUp).Row
ARASTR = 0: ARASTN = 0
For STN = 2 To S1.Cells(5, Columns.Count).End(xlToLeft).Column
If .CountIf(S2.Range("B:B"), S1.Cells(STR, "A").Value) > 0 Then
ARASTR = .Match(S1.Cells(STR, "A"), S2.Range("B:B"), 0)
Else
S1.Cells(STR, "A").Interior.Color = vbGreen
End If
If .CountIf(S2.Rows(5), S1.Cells(5, STN)) > 0 Then
ARASTN = .Match(S1.Cells(5, STN), S2.Rows(5), 0)
Else
S1.Cells(5, STN).Interior.Color = vbGreen
End If
If ARASTR <> Empty And ARASTN <> Empty Then
If S1.Cells(STR, STN) = S2.Cells(ARASTR, ARASTN) Then
S1.Cells(STR, STN).Interior.Color = vbBlue
S2.Cells(ARASTR, ARASTN).Interior.Color = vbBlue
Else
S1.Cells(STR, STN).Interior.Color = vbRed
S2.Cells(ARASTR, ARASTN).Interior.Color = vbRed
End If: End If
Next: Next
End With
For STR = 7 To S2.Cells(Rows.Count, "B").End(xlUp).Row
If S2.Cells(STR, "B").Interior.ColorIndex <> xlNone Then
S2.Cells(STR, "B").Interior.Color = vbGreen
End If: Next
For STN = 3 To S2.Cells(5, Columns.Count).End(xlToLeft).Column
If S2.Cells(5, STN).Interior.ColorIndex <> xlNone Then
S1.Cells(5, STN).Interior.Color = vbGreen
End If: Next
Application.ScreenUpdating = True
End Sub

Eline sağlık. Karşılaştırma güzel olmuş ama birde tutmayan rakamlar yani KIRMIZI OLANLARın 1. tablo ile 2. tablo arasında tutmayan kırmızı olanların farkları lazım. Yine ürün kodu ve uçuş kodlarına dikkate alarak tabikide.

Onuda yaparsanız tam istediğim gibi olacak.

Şimdiden sağolun.