puantaj raporlama

[gokhanbek]

günaydın

merhaba arkadaşlar

elimde bir aylık puantaj tablosu var bunun için günlük bir rapor almak istiyorum

ekte örnek bir dosya ekliyorum yardımcı olabilecek arkadaşlar var mı?

 

[gokhanbek]

galiba benim soru arada kaynadı

 

[Mahir64]

Merhaba,

Günlük listenin, tam olarak nasıl hazırlanacağı hakkında bilgi verirmisiniz.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub ÖZET_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long, TARİH As Range
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("aylık")
    Set S2 = Sheets("günlük")
    
    S2.Range("A3:F" & Rows.Count).ClearContents
    
    Set TARİH = S1.Rows("1:1").Find(S2.Range("A1"))
    If Not TARİH Is Nothing Then
        
        For X = 2 To S1.Cells(Rows.Count, 1).End(3).Row
            Select Case S1.Cells(X, TARİH.Column)
                Case Is = "s", "S"
                    S2.Cells(Rows.Count, 1).End(3).Offset(1) = S1.Cells(X, 1)
                Case Is = "ü", "Ü"
                    S2.Cells(Rows.Count, 2).End(3).Offset(1) = S1.Cells(X, 1)
                Case Is = "v", "V"
                    S2.Cells(Rows.Count, 3).End(3).Offset(1) = S1.Cells(X, 1)
                Case Is = "x", "X"
                    S2.Cells(Rows.Count, 4).End(3).Offset(1) = S1.Cells(X, 1)
                Case Is = "xx", "XX"
                    S2.Cells(Rows.Count, 5).End(3).Offset(1) = S1.Cells(X, 1)
                Case Is = "xxx", "XXX"
                    S2.Cells(Rows.Count, 6).End(3).Offset(1) = S1.Cells(X, 1)
            End Select
        Next
    
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Else
        
        MsgBox S2.Range("A1") & " tarihi bulunamamıştır !", vbCritical
    
    End If
    Set TARİH = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
End Sub

 

[gokhanbek]

çok teşekkür ederim korhan bey
emeğinize yüreğinize sağlık