Rapor Alma

[wishm]

Değerli site üyeleri hazırlamış olduğum programda raporlama ile ilgili sorun yaşadım. Forumdan aradım ancak istediğime uygun bir çalışma ve kod bulamadım. Sorunum şu: Bir excel çalışma kitabım var ve yaklaşık 100 cirarında sayfam var ve bu sayfalarda veriler kayıtlı. Sorun benim için buradan itibaren başlıyor sayfa sayım sabit değil yani zamanla artıyor. Dolayısiyle bu excel kitabıma kayıtlı v kaydedilecek sayfalardaki verileri bir rapor sayfasına aktarmak istiyorum. Bu konuda yardımcı olabilirseniz memnun olurum. Ekte örnek teşkil etmesi açısından bir dosya gönderdim ancak bu formata bağlı kalmak zorunda da değilim yani raporlama sayfası daha farklıda olabilir. (Örnek: sayfa başlangıcı sayfa bitişi gibi yeni bir kriter eklenebilir). Bu konuda yardımcı olabilirseniz memnun olurum. İlginiz ve yanıtlarınız için şimdiden teşekkür ederim. Saygılarımla.

 

[Orion1]

Dosyanız ektedir.

Private Sub CommandButton1_Click()
Dim sh As Worksheet, ilk As Date, son As Date, k As Range, adr As String
Dim sat As Long, sat2 As Long, deg As String
If Not IsDate(TextBox1.Text) Then
    MsgBox "İlk Tarih yanlış tarih girişi yapıldı.", vbCritical, "UYARI"
    TextBox1.SetFocus
    TextBox1.SelStart = 0
    TextBox1.SelLength = Len(TextBox1.Text)
    Exit Sub
End If
If Not IsDate(TextBox2.Text) Then
    MsgBox "İlk Tarih yanlış tarih girişi yapıldı.", vbCritical, "UYARI"
    TextBox2.SetFocus
    TextBox2.SelStart = 0
    TextBox2.SelLength = Len(TextBox2.Text)
    Exit Sub
End If
Sheets("rapor").Select
Application.ScreenUpdating = False
Range("A2:K65536").ClearContents
deg = UCase(Replace(Replace(ComboBox1.Value, "ı", "I"), "i", "İ"))
sat = 2
ilk = CDate(TextBox1.Text)
son = CDate(TextBox2.Text)

For Each sh In Worksheets
    If Left(UCase(Replace(sh.Name, "i", "İ")), 4) = "VERİ" Then
        sat2 = sh.Cells(65536, "C").End(xlUp).Row
        Set k = sh.Range("C2:C" & sat2).Find(deg, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                If sh.Cells(k.Row, "H").Value >= ilk And sh.Cells(k.Row, "H").Value <= son Then
                    Cells(sat, "A").Value = sat - 1
                    Range("B" & sat & ":K" & sat).Value = sh.Range("B" & k.Row & ":K" & k.Row).Value
                    sat = sat + 1
                End If
            Set k = sh.Range("C2:C" & sat2).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
        Set k = Nothing
    End If
Next sh
Application.ScreenUpdating = True
ListBox1.RowSource = vbNullString
If Sheets("rapor").Cells(65536, "C").End(xlUp).Row > 1 Then
    ListBox1.RowSource = "Rapor!A2:K" & Sheets("rapor").Cells(65536, "C").End(xlUp).Row
End If
End Sub

 

[wishm]

Sayın Evren Gizlen ilginiz ve yanıtınız için teşekkür ederim. İstediğim buydu. Saygılarımla.

 

[wishm]

Değerli site üyeleri dün sayın Evren Gizlen' in verdiğ cevapla sorunumu çözmüştüm. Ancak programda değişiklik yapma zorunluluğum gündeme geldi ve yukarıda ki kodlar sorunumu tam anlamıyla çözemez hale geldi. Dolayısiyle sizden tekrar aynı konuda yardım istiyorum. Özet olarak; Sayfa isimleri birbirinden farklı olan kişi isimlerinden oluşan, zamanla sayfa sayısı artacak olan bu çoklu sayfadan verileri alıp raporlamayı nasıl yapabilirim. İlginiz ve yanıtlarınız için şimiden teşekkür ederim. Saygılarımla.

 

[wishm]

Değerli site üyeleri bu konuda bana yardımcı olabilecek birileri yokmu acaba. Yardımcı olabilirseniz fikir vermekte dahil memnun olurum. Saygılarımla.

 

[Orion1]

Değerli site üyeleri dün sayın Evren Gizlen' in verdiğ cevapla sorunumu çözmüştüm. Ancak programda değişiklik yapma zorunluluğum gündeme geldi ve yukarıda ki kodlar sorunumu tam anlamıyla çözemez hale geldi. Dolayısiyle sizden tekrar aynı konuda yardım istiyorum. Özet olarak; Sayfa isimleri birbirinden farklı olan kişi isimlerinden oluşan, zamanla sayfa sayısı artacak olan bu çoklu sayfadan verileri alıp raporlamayı nasıl yapabilirim. İlginiz ve yanıtlarınız için şimiden teşekkür ederim. Saygılarımla.

Benim yazdığım kodlar Sayfa adları Veri ile başlayan tüm sayfalardan zaten veri alıyor.Kaç sayfa olursa olsun farketmez.Yalnız sayfaların adlarının ilk 4 harfi Veri olmalıdır.

 

[wishm]

Sayın Evren Gizlen yanıtınız ve çözümünüz için tekrar teşekkür ederim. Daha öncede belirttiğim gibi programımda değişiklik yapma zorunluluğu doğdu. Şu anda sayfa isimlerini (müşteri isimleri) listbox' ta listeletiyor ve tıklatınca da ilgili sayfaya gidiyor. Dolayısiyle ekranda veriAHMET, veriMEHMET gibi isimler gözükecek buda istediğim bir durum değil açıkçası. İlginiz ve yanıtınız için tekrar teşekkür ederim. Araştırmaya devam ediyorum eğer bir alternatife ulşacak olursam buradan da yayımlayacağım kodları. Saygılarımla.

 

[Orion1]

Sayın Evren Gizlen yanıtınız ve çözümünüz için tekrar teşekkür ederim. Daha öncede belirttiğim gibi programımda değişiklik yapma zorunluluğu doğdu. Şu anda sayfa isimlerini (müşteri isimleri) listbox' ta listeletiyor ve tıklatınca da ilgili sayfaya gidiyor. Dolayısiyle ekranda veriAHMET, veriMEHMET gibi isimler gözükecek buda istediğim bir durum değil açıkçası. İlginiz ve yanıtınız için tekrar teşekkür ederim. Araştırmaya devam ediyorum eğer bir alternatife ulşacak olursam buradan da yayımlayacağım kodları. Saygılarımla.

Yani diğer sayfaları karştırmamak için bir nirengi noktası almak lazım.Ben öyle düşünmüştüm.Eğer öyle olmuyorsa bu seferde data ve rapor sayfaları haricinde listeleme yapmak gerikiyor.Bende şimdiki dosyayı bu duruma göre yaptım.
Dosya ektedir.

Private Sub CommandButton1_Click()
Dim sh As Worksheet, ilk As Date, son As Date, k As Range, adr As String
Dim sat As Long, sat2 As Long, deg As String
If Not IsDate(TextBox1.Text) Then
    MsgBox "İlk Tarih yanlış tarih girişi yapıldı.", vbCritical, "UYARI"
    TextBox1.SetFocus
    TextBox1.SelStart = 0
    TextBox1.SelLength = Len(TextBox1.Text)
    Exit Sub
End If
If Not IsDate(TextBox2.Text) Then
    MsgBox "İlk Tarih yanlış tarih girişi yapıldı.", vbCritical, "UYARI"
    TextBox2.SetFocus
    TextBox2.SelStart = 0
    TextBox2.SelLength = Len(TextBox2.Text)
    Exit Sub
End If
Sheets("rapor").Select
Application.ScreenUpdating = False
Range("A2:L65536").ClearContents
deg = UCase(Replace(Replace(ComboBox1.Value, "ı", "I"), "i", "İ"))
sat = 2
ilk = CDate(TextBox1.Text)
son = CDate(TextBox2.Text)

For Each sh In Worksheets
    If sh.Name <> "data" And sh.Name <> "rapor" Then
        sat2 = sh.Cells(65536, "C").End(xlUp).Row
        Set k = sh.Range("C2:C" & sat2).Find(deg, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                If sh.Cells(k.Row, "H").Value >= ilk And sh.Cells(k.Row, "H").Value <= son Then
                    Cells(sat, "A").Value = sh.Name
                    Cells(sat, "B").Value = sat - 1
                    Range("C" & sat & ":L" & sat).Value = sh.Range("B" & k.Row & ":K" & k.Row).Value
                    sat = sat + 1
                End If
            Set k = sh.Range("C2:C" & sat2).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
        Set k = Nothing
    End If
Next sh
Application.ScreenUpdating = True
ListBox1.RowSource = vbNullString
If Sheets("rapor").Cells(65536, "C").End(xlUp).Row > 1 Then
    ListBox1.RowSource = "Rapor!A2:L" & Sheets("rapor").Cells(65536, "C").End(xlUp).Row
End If
End Sub

 

[wishm]

Sayın Evren Gizlen yanıtınız için çok teşekkür ederim sanırım son gönderdiğiniz kodlar sorunumu çözecek gibi gözüküyor. Kodlarınızı çalışmama uyarlayıp neticeyi sizlerle de paylaşacağım. İlginiz ve yanıtınız için teşekkür ederim. Saygılarımla.