• DİKKAT

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

Soru Makro çözümü

Katılım
27 Kasım 2019
Mesajlar
44
Excel Vers. ve Dili
excell
Merhaba,

Ekte yer alan veriler çok fazla olduğu için düşey arada dosya zorlanıyor. Kontrol sayfasında yer alan açıklmalar agöre bir makro yazılabilir mi?

saygılar,
 

Ekli dosyalar

Merhaba,

Öneri ;

"KONTROL" sayfası "A3:G13" aralığına olması gereken sonuçları elle girip, yeni bir dosya eklerseniz,

Makro yazacak üyelerimiz, sonucu kontrol edebilirler, dolayısıyla da doğru ve çabuk çözümler elde edebilirler.

Teşekkür ederim.
 
Deneyiniz.

C++:
Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim S4 As Worksheet, S5 As Worksheet, S6 As Worksheet
    Dim S7 As Worksheet, S8 As Worksheet
    Dim Veri As Variant, Son As Long, X As Long
    Dim Satir As Long, WF As WorksheetFunction
   
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
   
    Set S1 = Sheets("DATA")
    Set S2 = Sheets("VERİ1")
    Set S3 = Sheets("VERİ2")
    Set S4 = Sheets("VERİ3")
    Set S5 = Sheets("VERİ4")
    Set S6 = Sheets("VERİ5")
    Set S7 = Sheets("VERİ6")
    Set S8 = Sheets("KONTROL")
    Set WF = WorksheetFunction
   
    S8.Range("A2:L" & S8.Rows.Count).Clear
   
    Son = S2.Cells(S2.Rows.Count, 3).End(3).Row
    Veri = S2.Range("A2:L" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 7) = "00" Then
            If WF.CountIfs(S1.Range("C:C"), Veri(X, 3), S1.Range("D:D"), Veri(X, 11)) = 0 Then
                S8.Cells(Satir, 1) = CDate(Veri(X, 4))
                S8.Cells(Satir, 2).NumberFormat = "@"
                S8.Cells(Satir, 2) = Veri(X, 11)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("A2:B" & S8.Rows.Count).Sort S8.Range("A2"), xlAscending

    Son = S3.Cells(S3.Rows.Count, 3).End(3).Row
    Veri = S3.Range("A2:L" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 7) = "00" Then
            If WF.CountIfs(S1.Range("C:C"), Veri(X, 3), S1.Range("D:D"), Veri(X, 11)) = 0 Then
                S8.Cells(Satir, 3) = CDate(Veri(X, 4))
                S8.Cells(Satir, 4).NumberFormat = "@"
                S8.Cells(Satir, 4) = Veri(X, 11)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("C2:D" & S8.Rows.Count).Sort S8.Range("C2"), xlAscending

    Son = S4.Cells(S4.Rows.Count, 3).End(3).Row
    Veri = S4.Range("A2:K" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 6) = "00" Then
            If WF.CountIfs(S1.Range("D:D"), Veri(X, 10)) = 0 Then
                S8.Cells(Satir, 5) = CDate(Veri(X, 3))
                S8.Cells(Satir, 6).NumberFormat = "@"
                S8.Cells(Satir, 6) = Veri(X, 10)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("E2:F" & S8.Rows.Count).Sort S8.Range("E2"), xlAscending

    Son = S5.Cells(S5.Rows.Count, 3).End(3).Row
    Veri = S5.Range("A2:J" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 6) = "00" Then
            If WF.CountIfs(S1.Range("D:D"), Veri(X, 9)) = 0 Then
                S8.Cells(Satir, 7) = CDate(Veri(X, 3))
                S8.Cells(Satir, 8).NumberFormat = "@"
                S8.Cells(Satir, 8) = Veri(X, 9)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("G2:H" & S8.Rows.Count).Sort S8.Range("G2"), xlAscending

    Son = S6.Cells(S6.Rows.Count, 2).End(3).Row
    Veri = S6.Range("A2:J" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If WF.CountIfs(S1.Range("C:C"), Veri(X, 2)) = 0 Then
            S8.Cells(Satir, 9) = CDate(Replace(Replace(Veri(X, 9), "Z", ""), "T", " "))
            S8.Cells(Satir, 10).NumberFormat = "@"
            S8.Cells(Satir, 10) = Veri(X, 2)
            Satir = Satir + 1
        End If
    Next
   
    S8.Range("I2:J" & S8.Rows.Count).Sort S8.Range("I2"), xlAscending

    Son = S7.Cells(S7.Rows.Count, 7).End(3).Row
    Veri = S7.Range("A2:K" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If WF.CountIfs(S1.Range("C:C"), Veri(X, 7)) = 0 Then
            S8.Cells(Satir, 11) = CDate(Replace(Replace(Veri(X, 10), "Z", ""), "T", " "))
            S8.Cells(Satir, 12).NumberFormat = "@"
            S8.Cells(Satir, 12) = Veri(X, 7)
            Satir = Satir + 1
        End If
    Next
   
    S8.Range("K2:L" & S8.Rows.Count).Sort S8.Range("K2"), xlAscending

    S8.Columns.AutoFit
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
    Set S5 = Nothing
    Set S6 = Nothing
    Set S7 = Nothing
    Set S8 = Nothing
    Set WF = Nothing
   
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
@Korhan Ayhan

Hocam elinize sağlık.
Bir versiyonda
VERİ5 sayfasında yer alan 773244024 İŞLEM ID tutarını 14000 iken -14000 yaptım ve
VERİ6 sayfasındaki 668681248 İŞLEM ID tutarını -61952 iken 61952 olarak DATA sayfasına işledim sadece İŞLEM ID verisine göre tarama yapıldığı için doğal olarak bu sonuçlar KONTROL (2) sayfasına yansımadı bu nedenle sadece VERİ5 ve VERİ6 sayfaları için kontrolün hem İŞLEM ID hemde TUTAR ile eşlemesi sağlanabilir mi?
 

Ekli dosyalar

Deneyiniz.

C++:
Option Explicit

Sub Analiz()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim S4 As Worksheet, S5 As Worksheet, S6 As Worksheet
    Dim S7 As Worksheet, S8 As Worksheet
    Dim Veri As Variant, Son As Long, X As Long
    Dim Satir As Long, WF As WorksheetFunction
   
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
   
    Set S1 = Sheets("DATA")
    Set S2 = Sheets("VERİ1")
    Set S3 = Sheets("VERİ2")
    Set S4 = Sheets("VERİ3")
    Set S5 = Sheets("VERİ4")
    Set S6 = Sheets("VERİ5")
    Set S7 = Sheets("VERİ6")
    Set S8 = Sheets("KONTROL")
    Set WF = WorksheetFunction
   
    S8.Range("A2:R" & S8.Rows.Count).Clear
   
    Son = S2.Cells(S2.Rows.Count, 3).End(3).Row
    Veri = S2.Range("A2:L" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 7) = "00" Then
            If WF.CountIfs(S1.Range("C:C"), Veri(X, 3), S1.Range("D:D"), Veri(X, 11)) = 0 Then
                S8.Cells(Satir, 1) = CDate(Veri(X, 4))
                S8.Cells(Satir, 2).NumberFormat = "@"
                S8.Cells(Satir, 2) = Veri(X, 11)
                S8.Cells(Satir, 3) = Veri(X, 9)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("A2:B" & S8.Rows.Count).Sort S8.Range("A2"), xlAscending

    Son = S3.Cells(S3.Rows.Count, 3).End(3).Row
    Veri = S3.Range("A2:L" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 7) = "00" Then
            If WF.CountIfs(S1.Range("C:C"), Veri(X, 3), S1.Range("D:D"), Veri(X, 11)) = 0 Then
                S8.Cells(Satir, 4) = CDate(Veri(X, 4))
                S8.Cells(Satir, 5).NumberFormat = "@"
                S8.Cells(Satir, 5) = Veri(X, 11)
                S8.Cells(Satir, 6) = Veri(X, 9)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("C2:D" & S8.Rows.Count).Sort S8.Range("C2"), xlAscending

    Son = S4.Cells(S4.Rows.Count, 3).End(3).Row
    Veri = S4.Range("A2:K" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 6) = "00" Then
            If WF.CountIfs(S1.Range("D:D"), Veri(X, 10)) = 0 Then
                S8.Cells(Satir, 7) = CDate(Veri(X, 3))
                S8.Cells(Satir, 8).NumberFormat = "@"
                S8.Cells(Satir, 8) = Veri(X, 10)
                S8.Cells(Satir, 9) = Veri(X, 8)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("E2:F" & S8.Rows.Count).Sort S8.Range("E2"), xlAscending

    Son = S5.Cells(S5.Rows.Count, 3).End(3).Row
    Veri = S5.Range("A2:J" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 6) = "00" Then
            If WF.CountIfs(S1.Range("D:D"), Veri(X, 9)) = 0 Then
                S8.Cells(Satir, 10) = CDate(Veri(X, 3))
                S8.Cells(Satir, 11).NumberFormat = "@"
                S8.Cells(Satir, 11) = Veri(X, 9)
                S8.Cells(Satir, 12) = Veri(X, 7)
                Satir = Satir + 1
            End If
        End If
    Next
   
    S8.Range("G2:H" & S8.Rows.Count).Sort S8.Range("G2"), xlAscending

    Son = S6.Cells(S6.Rows.Count, 2).End(3).Row
    Veri = S6.Range("A2:J" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If WF.CountIfs(S1.Range("C:C"), Veri(X, 2), S1.Range("E:E"), Veri(X, 4)) = 0 Then
            S8.Cells(Satir, 13) = CDate(Replace(Replace(Veri(X, 9), "Z", ""), "T", " "))
            S8.Cells(Satir, 14).NumberFormat = "@"
            S8.Cells(Satir, 14) = Veri(X, 2)
            S8.Cells(Satir, 15) = Veri(X, 4)
            Satir = Satir + 1
        End If
    Next
   
    S8.Range("I2:J" & S8.Rows.Count).Sort S8.Range("I2"), xlAscending

    Son = S7.Cells(S7.Rows.Count, 7).End(3).Row
    Veri = S7.Range("A2:K" & Son).Value2
    Satir = 2
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If WF.CountIfs(S1.Range("C:C"), Veri(X, 7), S1.Range("E:E"), Veri(X, 4)) = 0 Then
            S8.Cells(Satir, 16) = CDate(Replace(Replace(Veri(X, 10), "Z", ""), "T", " "))
            S8.Cells(Satir, 17).NumberFormat = "@"
            S8.Cells(Satir, 17) = Veri(X, 7)
            S8.Cells(Satir, 18) = Veri(X, 4)
            Satir = Satir + 1
        End If
    Next
   
    S8.Range("K2:L" & S8.Rows.Count).Sort S8.Range("K2"), xlAscending

    S8.Columns.AutoFit
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
    Set S5 = Nothing
    Set S6 = Nothing
    Set S7 = Nothing
    Set S8 = Nothing
    Set WF = Nothing
   
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
@Korhan Ayhan

Hocam VERİ5 ve VERİ6 sayfalarındaki tutarlar format uyumsuzluğundan dolayı tüm data KONTROL sayfasında çıktı maalesef.
Bir de son bir rica olarak bu makro DATA sayfasında yaklaşık 1M ve diğer sayfalarda da 500K civarı veriyi çalıştırıyor. Veriler 1 ve ya daha fazla seneden oluşuyor. Tarihi sene ve ay olarak seçerek çalıştırırsak daha hızlı olması sağlanabilir mi?
 
Format uyumsuzluğu nedir?

Örnek vermelisiniz.

Bu kadar çok veriniz varsa yöntemi değiştirmek gerekir.
 
Format uyumsuzluğu nedir?

Örnek vermelisiniz.

Bu kadar çok veriniz varsa yöntemi değiştirmek gerekir.

Hocam,

kodun uyarlanmış halini ekledim şu şekilde önceki dosyalarda benim hatam belirtmeyi unutmuşum DATA sayfası tutar verisi formatı ile VERİ5 ve VERİ6 sayfaları tutar verisi formatı farklı. Dosyada görüleceği üzere bu uyumsuzluk nedeniyle KONTROL2 sayfasında kod VERİ5 ve VERİ6 sayfasındaki gelmesi gerekmeyen tüm verileri gerirmiş. Bunu demek istemiştim.

Yöntem değişikliğinden kastınız nedir?
 

Ekli dosyalar

VERİ6 sayfasında 2. satırdaki veri DATA sayfasında 22. satırda var. Fakat TUTAR bölümü eşleşmiyor. Bu sebeple makro bunu listeler. Çünkü #11 nolu mesajınızda aşağıdaki ifadeyi kullanmıştınız.

sadece VERİ5 ve VERİ6 sayfaları için kontrolün hem İŞLEM ID hemde TUTAR ile eşlemesi sağlanabilir mi?
 
VERİ6 sayfasında 2. satırdaki veri DATA sayfasında 22. satırda var. Fakat TUTAR bölümü eşleşmiyor. Bu sebeple makro bunu listeler. Çünkü #11 nolu mesajınızda aşağıdaki ifadeyi kullanmıştınız.

Evet hocam,

Yine benim hatam ifade eksikliği kusura bakmayın.

Kodun çalışma mantığı olan VERİ5 ve VERİ6 sayfaları için
'İŞLEM ID numarasını DATA sayfasında kontrol ederek DATA sayfasında olmayan İŞLEM ID no tarihe göre bu hücreyede gösterecek'
kısmına ek olarak
'İŞLEM ID ve TUTAR numarasını DATA sayfasında kontrol ederek DATA sayfasında olmayan İŞLEM ID no tarihe ve tutara göre bu hücreyede gösterecek'

Kod çalışıyor sadece DATA sayfası tutar verisi ile VERİ5 ve VERİ6 sayfası tutar verisi formatı farklı olması sorunu var.
 

Ekli dosyalar

İyide bu durum için benim ne yapmamı bekliyorsunuz?

Kod çalışıyor sadece DATA sayfası tutar verisi ile VERİ5 ve VERİ6 sayfası tutar verisi formatı farklı olması sorunu var.

Hem İŞLEM ID ve TUTAR kontrol edilsin diyorsunuz. Hem de TUTAR'lar farklı diyorsunuz. Sizce bir çelişki yok mu?
 
İyide bu durum için benim ne yapmamı bekliyorsunuz?



Hem İŞLEM ID ve TUTAR kontrol edilsin diyorsunuz. Hem de TUTAR'lar farklı diyorsunuz. Sizce bir çelişki yok mu?

Hocam,

Tutarlar farklı konusu değil Tutarların farklı formatta olması sıkıntısı var. Formatları farklı olsa da iki veriyi kontrol sağlanamaz mı. Örneğin
Kod:
.NumberFormat = "#,##0.00"
bu kod çalışır mı?
 
803339203 nolu ID için -1500 ile -15 değerleri nasıl aynı olabilir? Bunun formatla ilişkisini açıkçası ben bilemedim.
 
Geri
Üst