• DİKKAT

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

iki tarih arası rapor

P

puslukurt

Katılım
14 Kasım 2004
Mesajlar
299
Excel Vers. ve Dili
microsoft office professional plus 2016
Merhaba ;
aşağıdaki kod ile d9 hücresine bir tarih yazdığımda rapor sayfasına d9 hücresine yazdığım bilgiler geliyor. Acaba bu koda d9 hücresine tarih yazmayıpta, f9 hücresine ilk tarih f10 hücresine son tarihi yazsak tarihler arası dökümü verirmi ?



Private Sub CommandButton2_Click()

Dim i As Long, c As Range, sat As Long, sut As Integer
Dim Sr As Worksheet, syf As String

Set Sr = Sheets("rapor")

Application.ScreenUpdating = False
Sheets("giriş").Select

Sr.Range("A2:K" & Rows.Count).ClearContents
Sr.Range("C1") = Range("D9")
syf = Month(Range("D9"))
sat = 2
With Sheets(syf)

Set c = .Rows(3).Find(Range("D9"), , xlValues, xlWhole)
If Not c Is Nothing Then
sut = c.Column
End If
For i = 4 To .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(i, sut) <> "" Then
Sr.Cells(sat, "A") = .Cells(i, "A")
Sr.Cells(sat, "B") = .Cells(i, "C")
Sr.Cells(sat, "d") = .Cells(i, "ak")
Sr.Cells(sat, "e") = .Cells(i, "al")
Sr.Cells(sat, "f") = .Cells(i, "am")
Sr.Cells(sat, "g") = .Cells(i, "an")
Sr.Cells(sat, "h") = .Cells(i, "ao")
Sr.Cells(sat, "ı") = .Cells(i, "ap")
Sr.Cells(sat, "j") = .Cells(i, "aq")
Sr.Cells(sat, "k") = .Cells(i, "ar")
Sr.Cells(sat, "C") = .Cells(i, sut)
sat = sat + 1

End If
Next i
End With
Application.ScreenUpdating = True
Sheets("rapor").Select
 
yukarıdaki kod olmuyorsa başka kod da olabilir.
 
Merhaba,

Sorularınızı örnek dosya ekleyerek detaylı açıklamanızı rica ederim.
 
dosya ekte ömer bey
teşekkürler
 

Ekli dosyalar

Hangi veriyi nereden alacak onuda yazarmısınız. açıklamalı olsun.. yardımcı olalım..
 
deneme isimli dosyada 1,2,3...12, isimi sayfalar var bu sayfa isimleri her bir ayı temsil ediyor örneğin 1 sayfada ocak ayı var 1 ocak 31 ocak arasında işlenen rakamlar ver oradan alacak
2 sayfada 1 şubat 29 şubat arasında işlenen veriler var bunlar 12 sayfaya kadar böyle devam ediyor
 
Tablo düzenine göre iki tarih arasında alınan raporda ay taşması olmayacak sanırım.

Örneğin, başlandıç tarihinde ay ocak iken bitişte şubat olmayak?

Doğru mu anlamadım. Çünkü rapor sayfası düzeni bu yönde gibi.
 
evet doğru hocam
örneğin rapor alırken 10.01.2012 ile 31.01.2012 arasını aldırıcam
25.01.2012 ile 15.02.2012 gibi tarihin dökümünü almıyacağım.
 
Bu şekilde deneyin.

Kod: 
Private Sub CommandButton4_Click()
 
    Dim c       As Range, _
        Bas_Trh As Date, _
        Bit_Trh As Date, _
        Sg      As Worksheet, _
        Sr      As Worksheet, _
        St      As Worksheet, _
        bassut  As Integer, _
        bitsut  As Integer, _
        sonay   As Integer, _
        sonrp   As Integer, _
        sonsat  As Long
    
    Set Sg = Sheets("giriş")
    Set Sr = Sheets("rapor")
    Set St = Sheets("Termin")
    
    Application.ScreenUpdating = False
    Sg.Select
    
    Bas_Trh = Range("G9")
    Bit_Trh = Range("G10")
    
    If Bas_Trh = 0 Or Bit_Trh = 0 Then
        MsgBox "Tarih Hücreleri Yada Hücresi Boş"
        Exit Sub
    End If
    
    If Not Month(Bas_Trh) = Month(Bit_Trh) Then
        MsgBox "Farklı Aylar İçin Rapor Alamazsınız."
        Exit Sub
    End If
    
    With Sheets("" & Month(Bas_Trh) & "")
    
        Sr.Select
        Cells.Clear
        
        Set c = .Rows(3).Find(Bas_Trh, , xlFormulas, xlWhole)
        If Not c Is Nothing Then
            bassut = c.Column
        End If
        
        Set c = .Rows(3).Find(Bit_Trh, , xlValues, xlWhole)
        If Not c Is Nothing Then
            bitsut = c.Column + 1
        End If
        
        St.Range("B3:C3").Copy Range("A1")
        .Range(.Cells(3, bassut), .Cells(3, bitsut)).Copy Range("C1")
        
        sonay = .Cells(3, Columns.Count).End(xlToLeft).Column
        sonrp = Cells(1, Columns.Count).End(xlToLeft).Column
        sonsat = St.Cells(Rows.Count, "C").End(xlUp).Row
        
       .Range(.Cells(3, sonay - 7), .Cells(3, sonay)).Copy Cells(1, sonrp)
        St.Range("A4:A" & sonsat).Copy Range("A2")
        St.Range("C4:C" & sonsat).Copy Range("B2")
        
        .Range(.Cells(4, bassut), .Cells(sonsat, bitsut)).Copy Range("C2")
        .Range(.Cells(4, sonay - 7), .Cells(sonsat, sonay)).Copy
        Cells(2, sonrp).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        Application.CutCopyMode = False
    
    End With
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
End Sub
.
 
teşekkür

hocam tam istediğim gibi oldu Allah sizlerden razı olsun çok teşekkür ederim
 
hata

Merhaba Sayın Hocam ;
Tarihler arası rapora bastığımda hocam gayet güzel bir şekilde rapor sayfasına getiriyor bende sadece Cumartesi günü evde bunu denemiştim. Ancak bugun işyerimde denediğimde yine verileri güzel bir şekilde getiriyor ancak giriş sayfasına geri döndüğümde aynı rapor sayfasındaki verileri giriş sayfasınada getirdiğini farkettim.
Hocam veriler sadece rapor sayfasına gelsin birde giriş sayfası allak bullak oluyor.

hocam detaylı bir şekilde ekteki dosyada anlattım şimdiden teşekkür ederim.
 

Ekli dosyalar

Tüm kodları sayfa sıkıştırdığınız için bu şekilde oldu.

Eki inceleyin. Kodları module aldım.

.
 

Ekli dosyalar

evet hocam haklısınız
hocam deneme sayfasındaki yazdığım diğer sorunlarda çözülebilirmi?
 
#13 numaralı mesajdaki dosyayı güncelledim.
 
hocam iyi akşamlar ;
dosyayı inceledim. örnekleri çoğaltınca bazı hatalar verdi. ekteki dosyada anlattım. İlginize tekrar teşekkür ederim.
 

Ekli dosyalar

Ömer bey sizden son ricam ; 13 nolu mesajdaki dosya döngüsel başvuru hatası veriyor.

ben ekteki dosya da müşteri isimlerini çoğaltınca meydana çıktı?
Ayrıca 1-2 ayrıntı var onlarıda hallettik mi tamam.
ilgi ve alakanıza şimdiden teşekkür ederim
 

Ekli dosyalar

Rapor sayfasının düzeninin 1-2-3..deki sayfaların düzeni ile aynı olmasında bir sakınca varmı?
 
hayır hiçbir sakıncası yok hocam aynısı olabilir
 
puslukurt' Alıntı:
hayır hiçbir sakıncası yok hocam aynısı olabilir
Genişletmek için tıkla ...

Aktar kodlarını aşağıdakilerle değiştirin.

Kod: 
Sub Aktar()
 
    Dim c       As Range, _
        Bas_Trh As Date, _
        Bit_Trh As Date, _
        Sg      As Worksheet, _
        Sr      As Worksheet, _
        St      As Worksheet, _
        bassut  As Integer, _
        bitsut  As Integer, _
        sil     As Integer, _
        i       As Integer
 
    Set Sg = Sheets("giriş")
    Set Sr = Sheets("rapor")
    Set St = Sheets("Termin")
 
    Application.ScreenUpdating = False
    Sg.Select
 
    Bas_Trh = Range("G9")
    Bit_Trh = Range("G10")
 
    If Bas_Trh = 0 Or Bit_Trh = 0 Then
        MsgBox "Tarih Hücreleri Yada Hücresi Boş"
        Exit Sub
    End If
 
    If Not Month(Bas_Trh) = Month(Bit_Trh) Then
        MsgBox "Farklı Aylar İçin Rapor Alamazsınız."
        Exit Sub
    End If
 
    With Sheets("" & Month(Bas_Trh) & "")
 
        Sr.Select
        Cells.Clear
 
        .Cells.Copy Range("A1")
 
        Set c = .Rows(3).Find(Bit_Trh, , xlValues, xlWhole)
        If Not c Is Nothing Then
            bitsut = c.Column
        End If
 
        If bitsut <> 36 Then
            Range(Cells(1, bitsut + 1), Cells(Rows.Count, 36)).Delete
        End If
 
        Set c = .Rows(3).Find(Bas_Trh, , xlFormulas, xlWhole)
        If Not c Is Nothing Then
            bassut = c.Column
        End If
 
        If bassut <> 6 Then
            Range(Cells(1, 6), Cells(Rows.Count, bassut - 1)).Delete
        End If
 
        Set c = Rows(3).Find("VERİLEN", , xlValues, xlWhole)
        If Not c Is Nothing Then
            sil = c.Column
        End If
 
        For i = 103 To 4 Step -1
            If Cells(i, sil) = 0 Then
                Rows(i).Delete
            End If
        Next i
 
        On Error Resume Next
        Cells.SpecialCells(xlCellTypeFormulas, 16).ClearContents
 
    End With
 
 
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
 
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst