Tarih yada sayı içeren sabit hücreye ek koşul koyma sorunu

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Bu arada Assagidaki yaptigim sekilde bir makrom var bu sekilde calisiyor yanliz Mizan Sayfasinda " L2" (ilk tarih) Hucresine ve "M2" (son tarih) hucresine ek kosul eklemek istiyorum "Liste" Sayfasindaki "C:C" sutundaki (Tarih) deger Mizan sayfasindaki "L2" hucresinden Buyuk ve "M2:" Hucresinden kucukse diye ama ekledigim zaman (makro degerleri "Sifir" Getiriyor, Yardimci ola bilirmisiniz , bu arada bu makromda cok kasiyor daha hizli olan yapila bilirmi?

Calisan Makro;
{ Sub Toplamlar()

Set Data = Sheets("liste")
Set MizanRapor = Sheets("Mizan")

sonA = Data.Cells(Rows.Count, "H").End(3).Row
SonB = Data.Cells(Rows.Count, "C").End(3).Row

For satir = 2 To SonB

MizanRapor.Cells(satir, "D") = WorksheetFunction.SumIfs(Data.Range("J2:J" & sonA), Data.Range("G2:G" & sonA), _
MizanRapor.Cells(satir, "B"), Data.Range("H2:H" & sonA), MizanRapor.Cells(satir, "C"))
MizanRapor.Cells(satir, "E") = WorksheetFunction.SumIfs(Data.Range("K2:K" & sonA), Data.Range("G2:G" & sonA), _
MizanRapor.Cells(satir, "B"), Data.Range("H2:H" & sonA), MizanRapor.Cells(satir, "C"))
MizanRapor.Cells(satir, "G") = WorksheetFunction.SumIfs(Data.Range("N2:N" & sonA), Data.Range("G2:G" & sonA), _
MizanRapor.Cells(satir, "B"), Data.Range("H2:H" & sonA), MizanRapor.Cells(satir, "C"), Data.Range("N2:N" & sonA), ">" & "0")
MizanRapor.Cells(satir, "H") = WorksheetFunction.SumIfs(Data.Range("N2:N" & sonA), Data.Range("G2:G" & sonA), _
MizanRapor.Cells(satir, "B"), Data.Range("H2:H" & sonA), MizanRapor.Cells(satir, "C"), Data.Range("N2:N" & sonA), "<" & "0")

Next satir

End Sub }

ve usteki calisan makronun sonundaki (MizanRapor.Cells(satir, "C") ) SON Parantezi silip assagidakini ekliyorum ;

Data.Range("C2:C" & sonA), ">" & MizanRapor.Cells(2,12)) yani

1 ci kosulla ekledigim sekil bu sekilde = (MizanRapor.Cells(satir, "D") = WorksheetFunction.SumIfs(Data.Range("J2:J" & sonA), Data.Range("G2:G" & sonA), _
MizanRapor.Cells(satir, "B"), Data.Range("H2:H" & sonA), MizanRapor.Cells(satir, "C"),Data.Range("C2:C" & sonA), ">" & MizanRapor.Cells(2,12))



Yardim edebilirmisiniz,
Simdiden tesekkurler
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,318
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kullandığınız kodların yerine aşağıdaki kodu deneyiniz.

C++:
Option Explicit

Sub Mizan_Analizi()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim Aranan As String, Tarih1 As Date, Tarih2 As Date, Zaman As Double
  
    Zaman = Timer
  
    Set S1 = Sheets("rapor")
    Set S2 = Sheets("Liste")
    Set Dizi = CreateObject("Scripting.Dictionary")
  
    Tarih1 = S1.Range("L1")
    Tarih2 = S1.Range("L2")
  
    S1.Range("A2:I" & S1.Rows.Count).Clear
  
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    Veri = S2.Range("A2:U" & Son).Value
  
    ReDim Liste(1 To UBound(Veri), 1 To 9)
  
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 3) >= Tarih1 And Veri(X, 3) <= Tarih2 Then
            Aranan = Veri(X, 21) & Veri(X, 7) & Veri(X, 8)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Veri(X, 21)
                Liste(Say, 2) = Veri(X, 7)
                Liste(Say, 3) = Veri(X, 8)
                Liste(Say, 4) = Veri(X, 10)
                Liste(Say, 5) = Veri(X, 11)
                Liste(Say, 6) = Liste(Say, 4) - Liste(Say, 5)
                If Veri(X, 14) > 0 Then Liste(Say, 7) = Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Say, 8) = Veri(X, 14)
                Liste(Say, 9) = Liste(Say, 7) - Liste(Say, 8)
            Else
                Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 10)
                Liste(Dizi.Item(Aranan), 5) = Liste(Dizi.Item(Aranan), 5) + Veri(X, 11)
                Liste(Dizi.Item(Aranan), 6) = Liste(Dizi.Item(Aranan), 4) - Liste(Dizi.Item(Aranan), 5)
                If Veri(X, 14) > 0 Then Liste(Dizi.Item(Aranan), 7) = Liste(Dizi.Item(Aranan), 7) + Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Dizi.Item(Aranan), 8) = Liste(Dizi.Item(Aranan), 8) + Veri(X, 14)
                Liste(Dizi.Item(Aranan), 9) = Liste(Dizi.Item(Aranan), 7) - Liste(Dizi.Item(Aranan), 8)
            End If
        End If
    Next
  
    If Say > 0 Then
        S1.Range("A2").Resize(Say, 9) = Liste
        S1.Range("D2").Resize(Say, 6).Style = "Comma"
    End If
  
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
  
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Kullandığınız kodların yerine aşağıdaki kodu deneyiniz.

C++:
Option Explicit

Sub Mizan_Analizi()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim Aranan As String, Tarih1 As Date, Tarih2 As Date, Zaman As Double
 
    Zaman = Timer
 
    Set S1 = Sheets("rapor")
    Set S2 = Sheets("Liste")
    Set Dizi = CreateObject("Scripting.Dictionary")
 
    Tarih1 = S1.Range("L1")
    Tarih2 = S1.Range("L2")
 
    S1.Range("A2:I" & S1.Rows.Count).Clear
 
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    Veri = S2.Range("A2:U" & Son).Value
 
    ReDim Liste(1 To UBound(Veri), 1 To 9)
 
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 3) >= Tarih1 And Veri(X, 3) <= Tarih2 Then
            Aranan = Veri(X, 21) & Veri(X, 7) & Veri(X, 8)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Veri(X, 21)
                Liste(Say, 2) = Veri(X, 7)
                Liste(Say, 3) = Veri(X, 8)
                Liste(Say, 4) = Veri(X, 10)
                Liste(Say, 5) = Veri(X, 11)
                Liste(Say, 6) = Liste(Say, 4) - Liste(Say, 5)
                If Veri(X, 14) > 0 Then Liste(Say, 7) = Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Say, 8) = Veri(X, 14)
                Liste(Say, 9) = Liste(Say, 7) - Liste(Say, 8)
            Else
                Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 10)
                Liste(Dizi.Item(Aranan), 5) = Liste(Dizi.Item(Aranan), 5) + Veri(X, 11)
                Liste(Dizi.Item(Aranan), 6) = Liste(Dizi.Item(Aranan), 4) - Liste(Dizi.Item(Aranan), 5)
                If Veri(X, 14) > 0 Then Liste(Dizi.Item(Aranan), 7) = Liste(Dizi.Item(Aranan), 7) + Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Dizi.Item(Aranan), 8) = Liste(Dizi.Item(Aranan), 8) + Veri(X, 14)
                Liste(Dizi.Item(Aranan), 9) = Liste(Dizi.Item(Aranan), 7) - Liste(Dizi.Item(Aranan), 8)
            End If
        End If
    Next
 
    If Say > 0 Then
        S1.Range("A2").Resize(Say, 9) = Liste
        S1.Range("D2").Resize(Say, 6).Style = "Comma"
    End If
 
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
 
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Merhaba Korhan Bey,
Elinize Saglik Mukemmel olmus tek bir hata var rapordaki H sutunundaki bilgi NEGATIF (-) oldugu icin onun toplamasi lazim I satirinda yada H Sutunundaki nin POZITIFE cevrilmesi lazim onuda duzelte bilirmisini zahmet olmaz ise ,

Cok Tesekkurler,
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Korhan Bey ,
Yerini buldum ve duzelttim gerek kalmadi Cok Tesekkur ederim
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Korhan Bey ,
Yerini buldum ve duzelttim gerek kalmadi Cok Tesekkur ederim
Korhan Bey , tekrar ozur dileyerek yaziyorum TKM Kodlarini duzgun getirmiyor listeme listeme ekledigimde bazilarinda kod yok ve yanlis hesaplara getiriyor, va TKM kodunda gore A'dan Z ye siraya bilirmiyiz?
Tesekkurler
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Korhan Bey , tekrar ozur dileyerek yaziyorum TKM Kodlarini duzgun getirmiyor listeme listeme ekledigimde bazilarinda kod yok ve yanlis hesaplara getiriyor, va TKM kodunda gore A'dan Z ye siraya bilirmiyiz?
Tesekkurler
Nedenini Gordum simdi cok rahatsiz ediyorum kusura kalmayin
TMK kodunu ve hesap isimlerini LIsteden almissiniz sanirim onu KART Sayfasinda U,W,X Sutunlarindan alinmasi lazim onu duzelte bilirseniz sorun duzelecek sanirim.
Tesekkurler
 
Son düzenleme:

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,318
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu durumda sadece KART sayfasında bulunan hesap kodlarına ait rapor oluşacaktır. LİSTE sayfasında olan ve KART sayfasında olmayan kodlar rapor sayfasında listelenmeyecektir.
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Bu durumda sadece KART sayfasında bulunan hesap kodlarına ait rapor oluşacaktır. LİSTE sayfasında olan ve KART sayfasında olmayan kodlar rapor sayfasında listelenmeyecektir.
Evet hocam aynen dediginiz gibi KART sayfasina yeni hesap olunca ekliyorum ondan sonra islem yapiyorum LISTE mozan tutmazsa eksik olan kart varmi kontrol edip olmayani elle kartin altina ekliyorum cum TMK KODU islem yaparken herzaman aklima gelmiyor ve bos Kaliyor LISTEDE sonra ana hesap ve alt hesap ayni opanlar birnde TKM kodu koymamissam 2 farkli hesapmis gibi getiriyor,
Tesekkurler
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Evet hocam aynen dediginiz gibi KART sayfasina yeni hesap olunca ekliyorum ondan sonra islem yapiyorum LISTE mozan tutmazsa eksik olan kart varmi kontrol edip olmayani elle kartin altina ekliyorum cum TMK KODU islem yaparken herzaman aklima gelmiyor ve bos Kaliyor LISTEDE sonra ana hesap ve alt hesap ayni opanlar birnde TKM kodu koymamissam 2 farkli hesapmis gibi getiriyor,
Tesekkurler
Hocam sizinde dediginize istinaden ek olarak LISTE sayfasina "G" ve "H" sutuna girilicek verileri KART sayfasindaki "W" ve "X" sutunu gore kisitlasak eger kart sayfasinda varsra girilmesi saglansa ozaman mecburen kart sayfasina girmek zorunda kalinir, ve LISTE sayfasina "G" ve "H" sutuna exceli kasmayacak acilir menu gibi birsey yapila bilirmi ilk harfleri yazmaya bastigimda hucre assagida gosterir KART sayfasindaki veriye gore

Tesekkurler
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,318
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Kod "kart" ve "liste" sayfasındaki kodları dikkate alarak ortak bir liste oluşturur. Bu ortak listeye göre de mizan raporunu hazırlar.

C++:
Option Explicit

Sub Mizan_Analizi()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Dizi As Object
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim Aranan As String, Tarih1 As Date, Tarih2 As Date, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("rapor")
    Set S2 = Sheets("Liste")
    Set S3 = Sheets("kart")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Tarih1 = S1.Range("L1")
    Tarih2 = S1.Range("L2")
    
    S1.Range("A2:I" & S1.Rows.Count).Clear
    
    Son = S3.Cells(S3.Rows.Count, 21).End(3).Row
    Veri = S3.Range("A2:X" & Son).Value
    
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 21) & "|" & Veri(X, 23) & "|" & Veri(X, 24)
        If Not Dizi.Exists(Aranan) Then
            Say = Say + 1
            Dizi.Add Aranan, Say
        End If
    Next
    
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    Veri = S2.Range("A2:U" & Son).Value
    
    ReDim Liste(1 To UBound(Veri), 1 To 9)
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 3) >= Tarih1 And Veri(X, 3) <= Tarih2 Then
            Aranan = Veri(X, 21) & "|" & Veri(X, 7) & "|" & Veri(X, 8)
            If Dizi.Exists(Aranan) Then
                Liste(Dizi.Item(Aranan), 1) = Split(Aranan, "|")(0)
                Liste(Dizi.Item(Aranan), 2) = Split(Aranan, "|")(1)
                Liste(Dizi.Item(Aranan), 3) = Split(Aranan, "|")(2)
                Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 10)
                Liste(Dizi.Item(Aranan), 5) = Liste(Dizi.Item(Aranan), 5) + Veri(X, 11)
                Liste(Dizi.Item(Aranan), 6) = Liste(Dizi.Item(Aranan), 4) - Liste(Dizi.Item(Aranan), 5)
                If Veri(X, 14) > 0 Then Liste(Dizi.Item(Aranan), 7) = Liste(Dizi.Item(Aranan), 7) + Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Dizi.Item(Aranan), 8) = Liste(Dizi.Item(Aranan), 8) + Veri(X, 14)
                Liste(Dizi.Item(Aranan), 9) = Liste(Dizi.Item(Aranan), 7) + Liste(Dizi.Item(Aranan), 8)
            Else
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Split(Aranan, "|")(0)
                Liste(Say, 2) = Split(Aranan, "|")(1)
                Liste(Say, 3) = Split(Aranan, "|")(2)
                Liste(Say, 4) = Veri(X, 10)
                Liste(Say, 5) = Veri(X, 11)
                Liste(Say, 6) = Liste(Say, 4) - Liste(Say, 5)
                If Veri(X, 14) > 0 Then Liste(Say, 7) = Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Say, 8) = Veri(X, 14)
                Liste(Say, 9) = Liste(Say, 7) + Liste(Say, 8)
            End If
        End If
    Next
    
    If Say > 0 Then
        S1.Range("A2").Resize(Say, 9) = Liste
        S1.Range("D2").Resize(Say, 6).Style = "Comma"
        S1.Range("A2:I2").Resize(Say).Sort S1.Range("A2"), xlAscending
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Option Explicit Sub Mizan_Analizi() Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Dizi As Object Dim Son As Long, Veri As Variant, X As Long, Say As Long Dim Aranan As String, Tarih1 As Date, Tarih2 As Date, Zaman As Double Zaman = Timer Set S1 = Sheets("rapor") Set S2 = Sheets("Liste") Set S3 = Sheets("kart") Set Dizi = CreateObject("Scripting.Dictionary") Tarih1 = S1.Range("L1") Tarih2 = S1.Range("L2") S1.Range("A2:I" & S1.Rows.Count).Clear Son = S3.Cells(S3.Rows.Count, 21).End(3).Row Veri = S3.Range("A2:X" & Son).Value For X = LBound(Veri) To UBound(Veri) Aranan = Veri(X, 21) & "|" & Veri(X, 23) & "|" & Veri(X, 24) If Not Dizi.Exists(Aranan) Then Say = Say + 1 Dizi.Add Aranan, Say End If Next Son = S2.Cells(S2.Rows.Count, 1).End(3).Row Veri = S2.Range("A2:U" & Son).Value ReDim Liste(1 To UBound(Veri), 1 To 9) For X = LBound(Veri) To UBound(Veri) If Veri(X, 3) >= Tarih1 And Veri(X, 3) <= Tarih2 Then Aranan = Veri(X, 21) & "|" & Veri(X, 7) & "|" & Veri(X, 8) If Dizi.Exists(Aranan) Then Liste(Dizi.Item(Aranan), 1) = Split(Aranan, "|")(0) Liste(Dizi.Item(Aranan), 2) = Split(Aranan, "|")(1) Liste(Dizi.Item(Aranan), 3) = Split(Aranan, "|")(2) Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 10) Liste(Dizi.Item(Aranan), 5) = Liste(Dizi.Item(Aranan), 5) + Veri(X, 11) Liste(Dizi.Item(Aranan), 6) = Liste(Dizi.Item(Aranan), 4) - Liste(Dizi.Item(Aranan), 5) If Veri(X, 14) > 0 Then Liste(Dizi.Item(Aranan), 7) = Liste(Dizi.Item(Aranan), 7) + Veri(X, 14) If Veri(X, 14) < 0 Then Liste(Dizi.Item(Aranan), 8) = Liste(Dizi.Item(Aranan), 8) + Veri(X, 14) Liste(Dizi.Item(Aranan), 9) = Liste(Dizi.Item(Aranan), 7) + Liste(Dizi.Item(Aranan), 8) Else Say = Say + 1 Dizi.Add Aranan, Say Liste(Say, 1) = Split(Aranan, "|")(0) Liste(Say, 2) = Split(Aranan, "|")(1) Liste(Say, 3) = Split(Aranan, "|")(2) Liste(Say, 4) = Veri(X, 10) Liste(Say, 5) = Veri(X, 11) Liste(Say, 6) = Liste(Say, 4) - Liste(Say, 5) If Veri(X, 14) > 0 Then Liste(Say, 7) = Veri(X, 14) If Veri(X, 14) < 0 Then Liste(Say, 8) = Veri(X, 14) Liste(Say, 9) = Liste(Say, 7) + Liste(Say, 8) End If End If Next If Say > 0 Then S1.Range("A2").Resize(Say, 9) = Liste S1.Range("D2").Resize(Say, 6).Style = "Comma" S1.Range("A2:I2").Resize(Say).Sort S1.Range("A2"), xlAscending End If Set S1 = Nothing Set S2 = Nothing Set Dizi = Nothing MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _ "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation End Sub
Hocam elinize saglik Mukemmel olmus nedesem baska bilemedim Allah razi olsun
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Hocam elinize saglik Mukemmel olmus nedesem baska bilemedim Allah razi olsun
Hocam raporu getirirken Listede TMK kodunu Kart Sayfasindan getire bilirmi simdi yeni bir hesap ejkeyerek deneme yazptim Listede TMK kodunu bos birakinca bos getiriyor KART daki TMK kodunu ve hesai ekledim LISTEDE TMK kodu gormedigi icin KART ta olani getirmiyor,
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,318
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
TMK kodunu neden boş bırakıyorsunuz? Böyle bir ihyiyaç mı var?

TMK kodu zaten "kart" sayfasından alınıyor. Eğer "liste" isimli sayfada var olan bir TMK kodu "kart" sayfasında yoksa rapora bu TMK kodu ekleniyor.

"kart" sayfasında aralarda boş satır varsa koda ekleme yapabiliriz.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,318
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kod görsel olarak biraz daha iyi sonuç veriyor. Deneyiniz.

C++:
Option Explicit

Sub Mizan_Analizi()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Dizi As Object
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim Aranan As String, Tarih1 As Date, Tarih2 As Date, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("rapor")
    Set S2 = Sheets("Liste")
    Set S3 = Sheets("kart")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    Tarih1 = S1.Range("L3")
    Tarih2 = S1.Range("L4")
   
    S1.Range("A4:I" & S1.Rows.Count).Clear
   
    Son = S3.Cells(S3.Rows.Count, 21).End(3).Row
    Veri = S3.Range("A2:X" & Son).Value
   
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
   
    ReDim Liste(1 To Son, 1 To 9)
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 21) <> "" Then
            Aranan = Veri(X, 21) & "|" & Veri(X, 23) & "|" & Veri(X, 24)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Split(Aranan, "|")(0)
                Liste(Say, 2) = Split(Aranan, "|")(1)
                Liste(Say, 3) = Split(Aranan, "|")(2)
                Liste(Say, 4) = 0
                Liste(Say, 5) = 0
                Liste(Say, 6) = 0
                Liste(Say, 7) = 0
                Liste(Say, 8) = 0
                Liste(Say, 9) = 0
            End If
        End If
    Next
   
    Veri = S2.Range("A2:U" & Son).Value
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 3) >= Tarih1 And Veri(X, 3) <= Tarih2 Then
            Aranan = Veri(X, 21) & "|" & Veri(X, 7) & "|" & Veri(X, 8)
            If Dizi.Exists(Aranan) Then
                Liste(Dizi.Item(Aranan), 4) = Liste(Dizi.Item(Aranan), 4) + Veri(X, 10)
                Liste(Dizi.Item(Aranan), 5) = Liste(Dizi.Item(Aranan), 5) + Veri(X, 11)
                Liste(Dizi.Item(Aranan), 6) = Liste(Dizi.Item(Aranan), 4) - Liste(Dizi.Item(Aranan), 5)
                If Veri(X, 14) > 0 Then Liste(Dizi.Item(Aranan), 7) = Liste(Dizi.Item(Aranan), 7) + Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Dizi.Item(Aranan), 8) = Liste(Dizi.Item(Aranan), 8) + Veri(X, 14)
                Liste(Dizi.Item(Aranan), 9) = Liste(Dizi.Item(Aranan), 7) + Liste(Dizi.Item(Aranan), 8)
            Else
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Split(Aranan, "|")(0)
                Liste(Say, 2) = Split(Aranan, "|")(1)
                Liste(Say, 3) = Split(Aranan, "|")(2)
                Liste(Say, 4) = Veri(X, 10)
                Liste(Say, 5) = Veri(X, 11)
                Liste(Say, 6) = Liste(Say, 4) - Liste(Say, 5)
                If Veri(X, 14) > 0 Then Liste(Say, 7) = Veri(X, 14)
                If Veri(X, 14) < 0 Then Liste(Say, 8) = Veri(X, 14)
                Liste(Say, 9) = Liste(Say, 7) + Liste(Say, 8)
            End If
        End If
    Next
   
    If Say > 0 Then
        S1.Range("A4").Resize(Say, 9) = Liste
        S1.Range("D4").Resize(Say, 6).Style = "Comma"
        S1.Range("A4:I4").Resize(Say).Sort S1.Range("A4"), xlAscending, S1.Range("B4"), , xlAscending, S1.Range("C4"), xlAscending
    End If
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Hocam Hata veriyor

Bu satirda
Liste(Say, 1) = Split(Aranan, "|")(0)
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,318
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Uyguladığınız dosyayı paylaşırsanız kontrol etme şansım olur.
 

canburak

Altın Üye
Katılım
30 Kasım 2011
Mesajlar
205
Excel Vers. ve Dili
Ofis 2016 Tr 64 Bit , Turkce
Hocam Hata veriyor

Bu satirda
Liste(Say, 1) = Split(Aranan, "|")(0)
Hatta yukardaki yazdiginiza benzer sekilde , eger LISTEDE olupta KART sayfasinda olmayan Ana hesap ve Alt hesap KART taki listenin sonuna getire bilir TMK kodsuz ordan yeni yada hatali ise gorup duzelte bilirim yeni veya hata li ise
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,318
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sanırım rapor sayfasının formatını değiştirmişsiniz. Satır eklemişsiniz.
 
Üst