Soru Raporlama

[Bahattin Sungur]

merhaba, herkese kolay gelsin. bir raporlama makrosu oluşturmak ıstıyorum ama çözüm yolu bulamadım. Yardım edebilirseniz çok memnun olurum, şimdiden teşekkür ederim. Yen üye olduğum ıcın dosya nasıl yükleniyor bulamadım. Kusura bakmayın lütfen. Konu su 1 satırında tarihler, a sütununda firmalar ve b sütununda o firmaya ait urun adı bulunuyor. kesısım noktasında ıse o tarihte o urun üretilecek demek oluyor. örnek olarak
10.05 11.05
a firması x urunu 1
a firması y urunu 1
b firması x urunu 1 1

yanı a firmasının x urunu ve b firmasının x urunu 10.05 tarihinde üretilecek. Yapmak ıstedıgım bir rapor sayfası açmak ve o sayfada bir tarih yazmak ve raporla makrosunu çalıştırınca yazdığım tarihte üretilecek ürünleri bana filtrelemesi eğer dosya yüklemesini öğrenebilirsem size örnek bir dosya yüklemeye çalışacağım. yardımcı olabilirseniz çok sevınırım.

 

[Bahattin Sungur]

https://s6.dosya.tc/server/khj2db/Yeni_Microsoft_Excel_Calisma_Sayfasi.xlsx.html
lınk burada.
detay vermeyi unutmuşum lütfen kusura bakmayın. mesela tarihe 10.05 yazdım raporla dedim ve ürünler karsıma çıktı daha sonra tarıhı degıstırıp tekrar raporla dediğimde eskısı sılınecek ve yenısı tekrar gelecek şekilde olmalı. Bendeki makro bılgısı kayıt edilen makrolar ile sınırlı VBA öğrenmeye çalışıyorum ama kafam almıyor bir turlu basit anlatımlı dersler bılıyorsanız eğer onuda alabılırım. cok tesekkur ederım sımdıden sızı yorduğum ıcın üzgünüm.

 

[YUSUF44]

Aşağıdaki kodları rapor sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin. G3 hücresini değiştirdiğinizde makro otomatik çalışır ve raporlama yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G3]) Is Nothing Then Exit Sub
Set s1 = Sheets("plan")
son = s1.Cells(Rows.Count, "B").End(3).Row
eski = WorksheetFunction.Max(6, Cells(Rows.Count, "B").End(3).Row)
sonsut = s1.Cells(2, Columns.Count).End(xlToLeft).Column
Range("B6:G" & eski).ClearContents
If Target = "" Then Exit Sub
If IsDate(Target) = False Then Exit Sub
If WorksheetFunction.CountIf(s1.[A2:BZ2], Target) = 0 Then
    MsgBox "Girilen tarihe ait veri bulunmamaktadır!", vbInformation
    Exit Sub
Else
    Application.ScreenUpdating = False
        sut = WorksheetFunction.Match(Target, s1.[A2:BZ2], 0)
        Set con = VBA.CreateObject("adodb.Connection")
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
        sorgu = "select F1, F2, F3, F" & sut & " from[plan$A3:BZ" & son & "] where F" & sut & " is not null "
        Set rs = con.Execute(sorgu)
        [C6].CopyFromRecordset rs
        yeni = WorksheetFunction.Max(6, Cells(Rows.Count, "C").End(3).Row)
        For i = 6 To yeni
            Cells(i, "B") = i - 5
        Next
    Application.ScreenUpdating = True
End If
End Sub

 

[Bahattin Sungur]

Aşağıdaki kodları rapor sayfasının kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin. G3 hücresini değiştirdiğinizde makro otomatik çalışır ve raporlama yapar:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G3]) Is Nothing Then Exit Sub
Set s1 = Sheets("plan")
son = s1.Cells(Rows.Count, "B").End(3).Row
eski = WorksheetFunction.Max(6, Cells(Rows.Count, "B").End(3).Row)
sonsut = s1.Cells(2, Columns.Count).End(xlToLeft).Column
Range("B6:G" & eski).ClearContents
If Target = "" Then Exit Sub
If IsDate(Target) = False Then Exit Sub
If WorksheetFunction.CountIf(s1.[A2:BZ2], Target) = 0 Then
    MsgBox "Girilen tarihe ait veri bulunmamaktadır!", vbInformation
    Exit Sub
Else
    Application.ScreenUpdating = False
        sut = WorksheetFunction.Match(Target, s1.[A2:BZ2], 0)
        Set con = VBA.CreateObject("adodb.Connection")
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
        sorgu = "select F1, F2, F3, F" & sut & " from[plan$A3:BZ" & son & "] where F" & sut & " is not null "
        Set rs = con.Execute(sorgu)
        [C6].CopyFromRecordset rs
        yeni = WorksheetFunction.Max(6, Cells(Rows.Count, "C").End(3).Row)
        For i = 6 To yeni
            Cells(i, "B") = i - 5
        Next
    Application.ScreenUpdating = True
End If
End Sub

cook tesekkur ederım.

 

[Bahattin Sungur]

cook tesekkur ederım.

bır sey sormak ıstıyorum bu kodu otomatık calıstırmak ıstemıyorum bır butona baglamak ıstıyorum nasıl yapmam gerekıyor acaba.

 

[YUSUF44]

Aşağıdaki makroyu kullanabilirsiniz:

Sub rapor()
Set s1 = Sheets("plan")
Set s2 = Sheets("rapor")
son = s1.Cells(Rows.Count, "B").End(3).Row
eski = WorksheetFunction.Max(6, s2.Cells(Rows.Count, "B").End(3).Row)
sonsut = s1.Cells(2, Columns.Count).End(xlToLeft).Column
s2.Range("B6:G" & eski).ClearContents
If s2.[G3] = "" Then Exit Sub
If IsDate(s2.[G3]) = False Then Exit Sub
If WorksheetFunction.CountIf(s1.[A2:BZ2], s2.[G3]) = 0 Then
    MsgBox "Girilen tarihe ait veri bulunmamaktadır!", vbInformation
    Exit Sub
Else
    Application.ScreenUpdating = False
        sut = WorksheetFunction.Match(s2.[G3], s1.[A2:BZ2], 0)
        Set con = VBA.CreateObject("adodb.Connection")
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
        sorgu = "select F1, F2, F3, F" & sut & " from[plan$A3:BZ" & son & "] where F" & sut & " is not null "
        Set rs = con.Execute(sorgu)
        s2.[C6].CopyFromRecordset rs
        yeni = WorksheetFunction.Max(6, Cells(Rows.Count, "C").End(3).Row)
        For i = 6 To yeni
            Cells(i, "B") = i - 5
        Next
    Application.ScreenUpdating = True
End If
End Sub

 

[Bahattin Sungur]

çok teşekkür ederim. Yazdığınız kod fazlası ile ısımı görüyor. Sızı fazla yordum ama son bir sorum olacak VBA öğrenmeye çalışıyorum, yazdığınız kodu okumaya çalışıyorum ve belli bir kısmını okudum ama

Set con = VBA.CreateObject("adodb.Connection")
        con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""
        sorgu = "select F1, F2, F3, F" & sut & " from[plan$A3:GF" & son & "] where F" & sut & " is not null "
        Set rs = con.Execute(sorgu)
        [C6].CopyFromRecordset rs

kısmından hiçbir şey anlayamadım. Müsait olduğunuz bir vakit burayı açıklayabilir mısınız acaba ?

 

[YUSUF44]

Bu kısım ADO ve SQL ile rapor oluşturma kısmı. Set satırından sorgu ile başlayan kısıma kadar olan yerde bu yöntemle rapor alacağımızı tanımlıyoruz. Bu kısmı kopyala yapıştır yapıyorum, standart değişmez kodlar. Sadece sonundaki hdr=no kısmı veritabanının ya da tablonun durumuna göre hdr=yes olabiliyor. No olunca tabloda başlık yok anlamına, yes ise başlık var anlamına geliyor. Sizin dosyada başlıklar düzenli olmadığı için no olarak ayarladım.
sorgu ile başlayan kısım asıl işi yapan kısım. Burda hangi verileri hangi kritere göre hangi tablodan/veritabanından alacağımızı belirliyoruz. Buradaki F1, F2 vs veritabanındaki sütunları/alanları simgeliyor. F1 birinci sütun demek. Bunun yerine eğer hdr=yes deseydik köşeli parantez içinde başlıkları yazabilirdik, [tarih] gibi.

Sorgunun tümü çift tırnak içinde yer alıyor. Eğer araya başka değişkenler eklemek istiyorsak benim yaptığım gibi “ & sut & “ şeklinde arada bağlantı kurmak gerekiyor.

Burda kullandığım sut değişkeni aranan tarihin tabloda kaçıncı sütunda olduğunu gösteriyor. Başlıklarımız tarih gibi bir değişken olduğu yani sabit bir başlık olmadığı için bu yöntemi kullandım.
Set rs satırı da standart, değiştirmiyorum.

Son satır ise elde edilen sorgu sonucunun sayfaya aktarılmasını sağlıyor.
Ado SQL sorgusunun daha birçok ayrıntısı var, ben de yeni yeni öğreniyorum. Kullandıkça kendimi geliştiriyorum.

 

[Bahattin Sungur]

Zaman ayırdığınız ıcın çok teşekkür ederim. Bu bilgiler benim ıcın çok faydalı oldu aynı zamanda bu kadar detaylı anlattığınız ıcın ayrıyeten teşekkür ediyorum. Sağ olun.

 

[Bahattin Sungur]

Son olarak kodlar üzerinde biraz oynama yapmaya çalıştım. Çalışma mantıklarını çözmek ıcın ama rapor kısmında yeri bir turlu değiştiremedim. Yanı raporu ben j sutununa kaydırmaya calısıyorum yanı basıtce sıze gonderdıgım exceldekı rapor tablosunu kaydırmak ıstıyorum ama degıstırmem gereken kodu bulamadım. raporu yazmaya hep c6 hucresınden baslıyor. sıra no kısmını kaydırdım orda problem yasamadım ama ordan sonrası yok

HALLETTIM TESEKKURLER