• DİKKAT

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

İkinci Sayfaya Raporlama nasıl yapabilirim.

Katılım
26 Mart 2010
Mesajlar
9
Excel Vers. ve Dili
2007
Günlük iş takibi için yapmış olduğumuz excel tablosunda gün sonunda raporlama yapmak için süzme işlemi yaparak ayırt edip daha sonrada diğer sayfaya kopyala yapıştır yapmaktan ise raporlama yapmak için nasıl yapabilirim.:???:
 

Ekli dosyalar

Kod:
Sub aktar()
    Dim t As Date
    c = 8
    Sayfa2.[b9:h58].ClearContents
    t = InputBox("tarih girin")
    For i = 3 To [a65536].End(3).Row
        If Sayfa1.Cells(i, "l") = t Then
        c = c + 1
        Sayfa2.Cells(c, "b") = Sayfa1.Cells(i, "c")
        Sayfa2.Cells(c, "c") = Sayfa1.Cells(i, "d")
        Sayfa2.Cells(c, "d") = Sayfa1.Cells(i, "f")
        Sayfa2.Cells(c, "e") = "YAPILDI"
        ElseIf Sayfa1.Cells(i, "k") = t Then
        c = c + 1
        Sayfa2.Cells(c, "b") = Sayfa1.Cells(i, "c")
        Sayfa2.Cells(c, "c") = Sayfa1.Cells(i, "d")
        Sayfa2.Cells(c, "d") = Sayfa1.Cells(i, "f")
        Sayfa2.Cells(c, "e") = Sayfa1.Cells(i, "J")
    
    End If
    Next
End Sub
 
çok teşekkür ederim arkadaşım. emeğin için ama bir sornum var alttaki sekme isimlerine göre tanımlı değil sanırım ilk seferde çalışmadı ama daha sonra sekme isimlerini değiştirince çalıştı yalnış tek sorunum bende raporlamada 100 adeti geçmez ama 50 den sonra diğer sağ tarafta olan diğer 50 lik trafa devamını yazmıyor.tek sorunum bu.
 
Aşağıdaki şekilde deneyin.
Kod:
Sub aktar()
    Dim t As Date
    c = 8
    d = 8
    Sayfa2.[b9:h58].ClearContents
    Sayfa2.[j9:m58].ClearContents
    t = InputBox("tarih girin", , "05/01/2010")
    For i = 3 To Sayfa1.[a65536].End(3).Row
           If c = 58 Then GoTo 10
               If Sayfa1.Cells(i, "l") = t Then
               c = c + 1
               Sayfa2.Cells(c, "b") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(c, "c") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(c, "d") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(c, "e") = "YAPILDI"
            ElseIf Sayfa1.Cells(i, "k") = t Then
               c = c + 1
               Sayfa2.Cells(c, "b") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(c, "c") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(c, "d") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(c, "e") = "YAPILDI"
            End If
10
           If d = 58 Then MsgBox "İşlem Tamam": Exit Sub
           If Sayfa1.Cells(i, "l") = t Then
               d = d + 1
               Sayfa2.Cells(d, "j") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(d, "k") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(d, "l") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(d, "m") = "YAPILDI"
           ElseIf Sayfa1.Cells(i, "k") = t Then
               d = d + 1
               Sayfa2.Cells(d, "j") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(d, "k") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(d, "l") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(d, "m") = "YAPILDI"
           End If
     Next
End Sub
 
Dosya açılıyor fakat okunmuyor.farklı excel sürümü mü
 
evet arkadasım buda işe yarar ama ilk 50 elliliği doldurmadan ikinciye yazıyor.
 
Kod:
Sub aktar()
    Dim t As Date
    c = 8
    d = 8
    Sayfa2.[b9:h58].ClearContents
    Sayfa2.[j9:m58].ClearContents
    t = InputBox("tarih girin", , "05/01/2010")
    For i = 3 To Sayfa1.[a65536].End(3).Row
           If c = 58 Then GoTo 10
               If Sayfa1.Cells(i, "l") = t Then
               c = c + 1
               Sayfa2.Cells(c, "b") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(c, "c") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(c, "d") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(c, "e") = "YAPILDI"
            ElseIf Sayfa1.Cells(i, "k") = t Then
               c = c + 1
               Sayfa2.Cells(c, "b") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(c, "c") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(c, "d") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(c, "e") = "YAPILDI"
            End If

10
If c = 58 Then
           If d = 58 Then MsgBox "İşlem Tamam": Exit Sub
           If Sayfa1.Cells(i, "l") = t Then
               d = d + 1
               Sayfa2.Cells(d, "j") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(d, "k") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(d, "l") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(d, "m") = "YAPILDI"
           ElseIf Sayfa1.Cells(i, "k") = t Then
               d = d + 1
               Sayfa2.Cells(d, "j") = Sayfa1.Cells(i, "c")
               Sayfa2.Cells(d, "k") = Sayfa1.Cells(i, "d")
               Sayfa2.Cells(d, "l") = Sayfa1.Cells(i, "f")
               Sayfa2.Cells(d, "m") = "YAPILDI"
           End If
End If
     Next
End Sub
 
Geri
Üst