• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Veri karşılaştırma

1

1903emre34@gmail.com

Altın Üye
Katılım
29 Mayıs 2016
Mesajlar
945
Excel Vers. ve Dili
Microsoft Excel 2013 Türkçe
Merhaba,

Alt hesap sütünda ki hesap kodlarının yanlarında tutarlar hem borç hem de alacak bakiye yer almaktadır. (Pozitif veya negatif biçimde) benim istediği sayfa2 hesap kodların tutarları birbirine eşleşiyorsa sayfa2 yanında DOĞRU kelimesi getirilmesi şeklinde nasıl dko oluşturabiliriz. Örneğin, 10000001099 borç bakiyesinde 500,7, alacak bakiyesinde -500,7 yer alıyorsa DOĞRU birbirine eşleşmediği takdire YANLIŞ kelimesi gelmesi
 

Ekli dosyalar

merhaba,
ekli dosyanızı goremedigim icin elimdeki ornegi aynen paylasiyorum. kendinize uyarlayabilirsiniz sayfa1 a, b , c ,d stunlarina bakar sayfa2 nin a, b,c,d stunlari ile karsilastirir Üc veri de eslesiyorsa e sutununa dogru yazar. hesap kodu ve alacak , borc , ucununde es olmasi lazim. satir sırasi fark etmez biri sayfa birde 5. satirda digeri sayfa ikide 50. satirda olabilir.

not E sutunundaki verileri once temizliyor. sonra dogru yaziyor . orada veriniz varsa silinir yedek alarak deneyin


Sub Karsilastir()
Dim i As Long, _
Son As Long, _
Adr As String, _
c As Range, _
s1 As Worksheet, _
s2 As Worksheet

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Select
Application.ScreenUpdating = False
Son = s1.Cells(Rows.Count, "A").End(3).Row
Range("E2:E" & Son).ClearContents

For i = 2 To Son
With s2.Range("A:A")
Set c = .Find(s1.Cells(i, "A"), LookIn:=xlValues)
If Not c Is Nothing Then
Adr = c.Address
Do
If s1.Cells(i, "B") = s2.Cells(c.Row, "B") And _
s1.Cells(i, "C") = s2.Cells(c.Row, "C") And _
s1.Cells(i, "D") = s2.Cells(c.Row, "D") Then
s1.Cells(i, "E") = "DOGRU"
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Next i

Son = s2.Cells(Rows.Count, "A").End(3).Row
s2.Range("E2:E" & Son).ClearContents

For i = 2 To Son
With s1.Range("A:A")
Set c = .Find(s2.Cells(i, "A"), LookIn:=xlValues)
If Not c Is Nothing Then
Adr = c.Address
Do
If s2.Cells(i, "B") = s1.Cells(c.Row, "B") And _
s2.Cells(i, "C") = s1.Cells(c.Row, "C") And _
s2.Cells(i, "D") = s1.Cells(c.Row, "D") Then
s2.Cells(i, "E") = "DOGRU"
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Adr
End If
End With
Next i
End Sub
 
ALternatif;

Dosya ektedir. Kontrol ediniz.
Sonuc sayfası farklı oldu bu şekilde daha iyi gibi.

Hesap Kodu, Borç, Alacak, Doğru/Yanlış, Karşılaştırma referansı (Hangi borç yada hangi alacak ile eşitlendiğiniz gösterir)

Kod: 
'1 Alt hesap, 2 borç, 3 alacak, 4 doğru yanlış, 5 işlem gördü
Dim liste(100000, 5) As String
Dim sonucliste(100000, 3) As String
Dim say, sonsatir, listesay As Long
Dim shsayfa2 As Worksheet

Sub menu()
    Sheets("Sayfa1").Select
    Call liste_yukle
    Call karsilastir
    Call eslesmedi
    Sheets("Sayfa2").Select
End Sub

Sub eslesmedi()
   say = 0
   For i = 1 To sonsatir
       say = say + 1
       shsayfa2.Cells(say, "A").Value = liste(i, 1)
       shsayfa2.Cells(say, "B").Value = liste(i, 2)
       shsayfa2.Cells(say, "C").Value = liste(i, 3)
       shsayfa2.Cells(say, "D").Value = liste(i, 4)
       shsayfa2.Cells(say, "E").Value = liste(i, 5)
   Next i
End Sub

Sub liste_yukle()
   sonsatir = Cells(Rows.Count, "E").End(3).Row
   say = 0
   For i = 1 To sonsatir
     liste(i, 1) = Cells(i, "E").Value
     liste(i, 2) = Cells(i, "F").Value
     liste(i, 3) = Cells(i, "G").Value
     liste(i, 4) = "YANLIŞ"
     liste(i, 5) = ""
   Next i
   listesay = i - 1
End Sub

Sub karsilastir()
   Set shsayfa2 = Sheets("Sayfa2")
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   shsayfa2.Range("A:E").Clear
   say = 0
   For i = 2 To listesay
     borchesap = liste(i, 1)
     If liste(i, 2) = "" Then borc = 0 Else borc = 0 + liste(i, 2)
     eksialacak = borc * (-1)
     islemdurumu = liste(i, 5)
     If islemdurumu <> "" Or borc = 0 Then GoTo son
     buldu = False
     For j = 2 To listesay
       alacakhesap = liste(j, 1)
       If liste(j, 3) = "" Then alacak = 0 Else alacak = 0 + liste(j, 3)
       islemdurumu = liste(j, 5)
       If islemdurumu <> "" Or alacak = 0 Then GoTo son1
       If borchesap = alacakhesap And eksialacak = alacak Then
          say = say + 1
          'shsayfa2.Cells(say, 1) = borchesap
          'shsayfa2.Cells(say, 2) = borc
          'shsayfa2.Cells(say, 3) = alacak
          'shsayfa2.Cells(say, 4) = "DOĞRU"
          liste(i, 4) = "DOĞRU"
          liste(j, 4) = "DOĞRU"
          liste(i, 5) = say
          liste(j, 5) = say
          buldu = True
          Exit For
       End If
  
son1:
  
     Next j
        a = a
son:
   Next i
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub
 

Ekli dosyalar

Son düzenleme:
asri' Alıntı:
ALternatif;

Dosya ektedir. Kontrol ediniz.
Sonuc sayfası farklı oldu bu şekilde daha iyi gibi.

Kod: 
Dim liste(100000, 3) As String
Dim sonucliste(100000, 3) As String
Dim say, sonsatir, listesay As Long
Dim shsayfa2 As Worksheet


Sub menu()
    Sheets("Sayfa1").Select
    Call liste_yukle
    Call karsilastir
    Call eslesmedi
End Sub

Sub eslesmedi()
   For i = 2 To sonsatir
    If liste(i, 3) = "" Then
       say = say + 1
       shsayfa2.Cells(say, "A").Value = liste(i, 1)
       shsayfa2.Cells(say, "B").Value = 0 + liste(i, 2)
       shsayfa2.Cells(say, "C").Value = ""
       shsayfa2.Cells(say, "D").Value = "YANLIŞ"
    End If
   Next i
End Sub

Sub liste_yukle()
   sonsatir = Cells(Rows.Count, "E").End(3).Row
   say = 0
   For i = 1 To sonsatir
     liste(i, 1) = Cells(i, "E").Value
     liste(i, 2) = Cells(i, "F").Value
     liste(i, 3) = ""
   Next i
   listesay = i - 1
End Sub

Sub karsilastir()
   Set shsayfa2 = Sheets("Sayfa2")
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   shsayfa2.Range("A:C").Clear
   say = 0
   For i = 1 To listesay
     borchesap = liste(i, 1)
     If borchesap = "Alt Hesap" Then GoTo son
     borc = 0 + liste(i, 2)
     arananalacak = borc * (-1)
     For j = 1 To listesay
       alacakhesap = liste(j, 1)
       If liste(j, 2) = "Borç" Then GoTo son1
       alacak = 0 + liste(j, 2)
       If arananalacak = alacak And liste(i, 3) = "" Then
          say = say + 1
          shsayfa2.Cells(say, 1) = borchesap
          shsayfa2.Cells(say, 2) = borc
          shsayfa2.Cells(say, 3) = alacak
          shsayfa2.Cells(say, 4) = "DOĞRU"
          liste(i, 3) = say
          liste(j, 3) = say
       End If
son1:
     Next j
son:
   Next i
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub
Genişletmek için tıkla ...

Merhaba,

Olumlu sonuç alamadım, dosya ekte gibidir
 

Ekli dosyalar

Kod ve dosya güncellendi.
 
benim sorunum sayfa.Range("A:A").ClearContents burda sarı bi uyarı alıyorum
Runtime Error 424 Object required bu sorunu nasıl çözerim yardımcı olabilir misiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst