• DİKKAT

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

Makro ile tarihe göre sıralama yardım...

Katılım
2 Mart 2011
Mesajlar
120
Excel Vers. ve Dili
İşyerinnde Excel 2003
Evde Excel 2010
Arkadaşlar ekteki dosyada sayfa 2 deki rapor ver butonuna tıklığımda sayfa 1 deki tarih / satış yapan / müşteri ... diye giden menü dahil olacak ve tarihlerin bulunduğu sütuna göre istediğim tarih aralığında (07.05.2011-31.05.2011 diye tarih girtikten sonra bu aradaki satışları) rapor verecek ve bu raporu ayrı excel dosyası olarak istediğim bir dizine kaydedecek böyle bisey yapabilir miyiz acaba ?
 

Ekli dosyalar

Arkadaşlar ekteki dosyada sayfa 2 deki rapor ver butonuna tıklığımda sayfa 1 deki tarih / satış yapan / müşteri ... diye giden menü dahil olacak ve tarihlerin bulunduğu sütuna göre istediğim tarih aralığında (07.05.2011-31.05.2011 diye tarih girtikten sonra bu aradaki satışları) rapor verecek ve bu raporu ayrı excel dosyası olarak istediğim bir dizine kaydedecek böyle bisey yapabilir miyiz acaba ?

merhaba
bir module atayarak deneyiniz
Kod:
Sub tarih()
Set Sv = Sheets("Sayfa1")
Application.ScreenUpdating = False
Sheets("Sayfa2").Select
sonB = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:I" & sonB).Borders.LineStyle = 0
Range("A1:I" & Rows.Count).ClearContents
sat = 2
a = InputBox("Tarih Giriniz", "İlk Tarih Girişi")
b = InputBox("Tarih Giriniz", "Son Tarih Girişi")
Range("A1") = Sheets("Sayfa1").Range("A5").Value
Range("B1") = Sheets("Sayfa1").Range("B5").Value
Range("C1") = Sheets("Sayfa1").Range("C5").Value
Range("D1") = Sheets("Sayfa1").Range("D5").Value
Range("E1") = Sheets("Sayfa1").Range("E5").Value
Range("F1") = Sheets("Sayfa1").Range("F5").Value
Range("G1") = Sheets("Sayfa1").Range("G5").Value
Range("H1") = Sheets("Sayfa1").Range("H5").Value
Range("I1") = Sheets("Sayfa1").Range("I5").Value
For i = 6 To Sv.Cells(Rows.Count, "A").End(xlUp).Row
If CDate(Sv.Cells(i, "A")) >= a And CDate(Sv.Cells(i, "A")) <= b Then
Sv.Range("A" & i & ":I" & i).Copy Range("A" & sat)
sat = sat + 1
End If
Next i
Application.ScreenUpdating = True
sonC = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:I" & sonC).Borders.LineStyle = 1
MsgBox Format(a, "dd.mm.yyyy") & " ve " & Format(b, "dd.mm.yyyy") & " Arasındaki Veriler Aktarılmıştır", , "İhsan Tank"
ActiveWorkbook.SaveAs Filename:="[COLOR="Red"]D:\aaa\[/COLOR]" & Format(a, "dd.mm.yyyy") & " ile " & Format(b, "dd.mm.yyyy") & ".xls"
Application.DisplayAlerts = False
Sheets("Sayfa1").Delete
Sheets("Sayfa3").Delete
End Sub
kırmızıya boyadığım yer dizin yoludur.
Not : Klasör ismi yazdıktan sonra \ ( flash ) işareti koymayı unutmayınız
 
çalışmıştım. dışarı çıkarken yüklemeyi atlamışım.
alternatif olarak bulunsun.

filtre yöntemini kullandım.


Kod:
Sub tarih_filtre()

Dim wb As Workbook
Dim rng As Range
Dim sat As Long, idt As Long, sdt As Long
Dim iDate As Date, sDate As Date
Dim ilk, son
Dim fName As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wb = ThisWorkbook
sat = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Worksheets("Sayfa1").Range("A5:I" & sat)

ilk = Application.InputBox("Başlangıç Tarih Giriniz")
son = Application.InputBox("Bitiş Tarih Giriniz")

iDate = DateSerial(Year(ilk), Month(ilk), Day(ilk))
sDate = DateSerial(Year(son), Month(son), Day(son))

idt = iDate
sdt = sDate

With rng
    .AutoFilter Field:=1
    .AutoFilter Field:=1, Criteria1:=">=" & idt, Operator:=xlAnd, Criteria2:="<=" & sdt
End With

On Error Resume Next
Worksheets("Rapor").Delete
Worksheets.Add().Name = "Rapor"

Set rng = rng.SpecialCells(xlCellTypeVisible)
rng.Copy Worksheets("Rapor").Range("A1")

fName = "C:\Users\rapor\" '[COLOR="red"]kendi klasörünüze göre burayı düzenleyin[/COLOR]
fName = fName & "Rapor " & ilk & " - " & son & ".xls" '[COLOR="red"]kendi vereceğiniz isme göre burayı düzenleyin[/COLOR]

Worksheets("Rapor").Move
Columns("A:I").AutoFit
ActiveWorkbook.SaveAs Filename:=fName
ActiveWorkbook.Close '[COLOR="Red"]dosya açık kalacak ise burayı silin[/COLOR]

rng.AutoFilter Field:=1

Set wb = Nothing
Set rng = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub
 

Ekli dosyalar

Arkadaşlar ekte bir dosya verdim bu dosya üzerinde lazım bana bu rapor işi. Biraz geç bakabildim konuya anca vakit bulabildim.

Şimdi sıfır satışlar sayfasına bi kaç satış türü ekledim. Tarih satış yapan vb. mevcut. Rapor sekmesindeki butonlara tıkladığımda ilgili sayfadan raporu verecek istenilen tarih aralığında ve bunu mümkünse satış raporları diye yeni bi excel sayfası oluşturup bu sayfa içinde hem sıfır satış hem 2. el satış hemde zirai satış sayfarından aldığı raporu alt alta yazacak. karışık oldu ama anlamadığınız yer olursa daha detaylı anlatmaya çalışayım ben.

ekte örnek dosya var ona göre uyarlayabilirsek çok iyi olacak.
girişte sizden kullanıcı adı şifre ister, Kullanıcı adı: OĞUZ Şifre: OĞUZ3543


GİREBİLİRSİNİZ BU ŞEKİLDE. TEŞEKKÜRLER ŞİMDİDEN YARDIM EDEN HERKESE..
 
Geri
Üst