Günlük Takip Çalışması,

[Utekiner]

Değerli Hocalarım Merhaba,

2020 yılında ekteki örnek çalışma da bir rapor hazırlamaya çalışıyorum. Vakit ayırabilir misiniz.

Ekteki dosyanın Detay sayfasında raporlamak istediğim sütunlara ait bilgileri belirttim.
Akış Sayfasındaki Malzeme No - Hedef sayfasında mevcut ise, A ile O satır aralığının yeşil ile renklendirmek istiyorum.
Akış sayfasında veriler kümüle olarak günlük eklenmektedir. Yıl sonuna kadar 5.000 ile 7.000 arasında satır veri girişi yapılacaktır.

Makro formül hangisi uygun ise konu hakkında siz değerli hocalarımdan destek bekliyorum.

https://s4.dosya.tc/server9/jlnkce/Kumile_Takip.xlsx.html

 

[Asri]

Tam tersini yapmak daha doğru gibi geldi

Hedef deki malzeme no akışda var ise A ile O arasını renklendirir.

Kontrol ediniz.

 

[Utekiner]

@asri hocam doğru diyorsunuz. Elinize sağlık. Detay sayfası için destek olabilir misiniz. Formül ve makro bilgim pek yok.

 

[gicimi]

Detay sayfasında sanırım türe ve tipe göre Akış sayfasının OK BŞSZ ve Malzeme Türüne göre saydırmak istiyorsunuz.

 

[Utekiner]

resimdeki şekilde kriterlere göre saydırmak istiyorum. Lütfen yardımcı olabilir misiniz.

 

[gicimi]

Hocam destek ekibi yardımcı olur size. Buna benzer makrom vardı. Bilgisayarım serviste paylaşamadım.

 

[Korhan Ayhan]

Örnek dosyayı inceleyiniz.

Bir yardımcı sütun kullanılmıştır.

 

[Utekiner]

@Korhan Ayhan çok teşekkür ederim. Allah razı olsun sizden..

 

[MrExcelMr]

@Korhan Ayhan Bey bu çalışma makro ile yapılma şansı var mı. Örnekteki formülleri kullanarak bir çalışma yaptım. Şöyle bir sıkıntı ile karşılaşıyorum. Satır sayısının artmasıyla excel dosyası hata alıyor kasılıyor.

 

[Korhan Ayhan]

Satır sayısı yüksek dosyalarda TOPLA.ÇARPIM fonksiyonu kullanımı çok uygun değildir. Makro kullanmak daha verimli sonuç verecektir.

Deneyiniz.

 

[MrExcelMr]

@Korhan Ayhan Bey değerli vaktinizi ayırdığınız için çok teşekkür ederim.

 

[MrExcelMr]

@Korhan Ayhan Bey sizi tekrar rahatsız ediyorum.
Örnekte belirtilen AKIŞ Sayfasındaki J ve K yardımcı sütunlar AD ve AE sütunlarında olduğunu düşünürsek kodda hangi satırlar değişmeli.

Option Explicit

Sub Durum_Raporu()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Dizi As Object
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Z As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("DETAY")
    Set S2 = Sheets("AKIŞ")
    Set S3 = Sheets("HEDEF")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    S1.Range("B4:F7").ClearContents
    S1.Range("B14:F17").ClearContents
    
    Son = S3.Cells(S3.Rows.Count, 1).End(3).Row
    Veri = S3.Range("A2:A" & Son).Value
    
    For X = 1 To UBound(Veri)
        Dizi(Veri(X, 1)) = 1
    Next
    
    Son = S2.Cells(S2.Rows.Count, 5).End(3).Row
    Veri = S2.Range("E2:J" & Son).Value
    
    For X = 1 To UBound(Veri)
        For Y = 4 To 7
            For Z = 2 To 6
                If Dizi.Exists(Veri(X, 4)) Then
                    If Veri(X, 5) = S1.Cells(Y, 1) Then
                        If Z < 4 Then
                            If Veri(X, 1) = S1.Cells(2, Z) Then
                                S1.Cells(Y, Z) = S1.Cells(Y, Z) + 1
                            End If
                        Else
                            If Veri(X, 6) = S1.Cells(3, Z) Then
                                S1.Cells(Y, Z) = S1.Cells(Y, Z) + 1
                            End If
                        End If
                    End If
                Else
                    If Veri(X, 5) = S1.Cells(Y + 10, 1) Then
                        If Z < 4 Then
                            If Veri(X, 1) = S1.Cells(12, Z) Then
                                S1.Cells(Y + 10, Z) = S1.Cells(Y + 10, Z) + 1
                            End If
                        Else
                            If Veri(X, 6) = S1.Cells(13, Z) Then
                                S1.Cells(Y + 10, Z) = S1.Cells(Y + 10, Z) + 1
                            End If
                        End If
                    End If
                End If
            Next
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[Korhan Ayhan]

Deneyiniz.

Değişen satırların yanına "Bu satır değişti." ibaresini yazdım.

Option Explicit

Sub Durum_Raporu()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Dizi As Object
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Z As Long, Zaman As Double
  
    Zaman = Timer
  
    Set S1 = Sheets("DETAY")
    Set S2 = Sheets("AKIŞ")
    Set S3 = Sheets("HEDEF")
    Set Dizi = CreateObject("Scripting.Dictionary")
  
    S1.Range("B4:F7").ClearContents
    S1.Range("B14:F17").ClearContents
  
    Son = S3.Cells(S3.Rows.Count, 1).End(3).Row
    Veri = S3.Range("A2:A" & Son).Value
  
    For X = 1 To UBound(Veri)
        Dizi(Veri(X, 1)) = 1
    Next
  
    Son = S2.Cells(S2.Rows.Count, 5).End(3).Row
    Veri = S2.Range("E2:AE" & Son).Value 'Bu satır değişti.
  
    For X = 1 To UBound(Veri)
        For Y = 4 To 7
            For Z = 2 To 6
                If Dizi.Exists(Veri(X, 4)) Then
                    If Veri(X, 5) = S1.Cells(Y, 1) Then
                        If Z < 4 Then
                            If Veri(X, 1) = S1.Cells(2, Z) Then
                                S1.Cells(Y, Z) = S1.Cells(Y, Z) + 1
                            End If
                        Else
                            If Veri(X, 26) = S1.Cells(3, Z) Then 'Bu satır değişti.
                                S1.Cells(Y, Z) = S1.Cells(Y, Z) + 1
                            End If
                        End If
                    End If
                Else
                    If Veri(X, 5) = S1.Cells(Y + 10, 1) Then
                        If Z < 4 Then
                            If Veri(X, 1) = S1.Cells(12, Z) Then
                                S1.Cells(Y + 10, Z) = S1.Cells(Y + 10, Z) + 1
                            End If
                        Else
                            If Veri(X, 26) = S1.Cells(13, Z) Then 'Bu satır değişti.
                                S1.Cells(Y + 10, Z) = S1.Cells(Y + 10, Z) + 1
                            End If
                        End If
                    End If
                End If
            Next
        Next
    Next
  
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[MrExcelMr]

@Korhan Ayhan Bey süpersiniz. Vakit ayırdığınız için minnetarım.