Soru tarih ve projeye göre ayrı sayfalar oluşturma

Katılım
15 Ocak 2019
Mesajlar
229
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
06-03-2024
Merhaba;

İşimi kolaylaştıracak ve zaman kazandıracağını düşündüğüm makro koduna ihtiyacım var.
Örnek olarak ekte paylaştığım ve sarı ile boyadığım A VE G sütunundaki verilere göre binlerce satırdan oluşan günlük datalarım mevcut.

Soru: Tarihe ve projeye göre kaynak dosyadan alıp, yeni bir çalışma kitaplarına bölmek istiyorum.

Böyle bir şey mümkün müdür, yardımlarınız için şimdiden teşekkür ederim.

Örnek
: 01.09.2021 tarihinde g sütunda kaç adet benzersiz proje adı var ise; ayrı çalışma sayfasına proje isimleri adında çalışma raporu oluşturmak istiyorum.

İstediğim örnek dosya ektedir.

Data dosyası Önizleme:
230109

İstediğim dosya önizleme
230112
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Linki inceleyiniz. Linkte sizinde mesajınız varmış. :)

 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Ben de bir şeyler hazırlamıştım, pratik yapmak için.
ADO ile verdiğiniz örnekler doğrultusunda çalışıyor.
Projelere göre yevmiye. raporu.xlsx sizin mevcut dosyanız ve (eğer makro içeriyor ve uzantııs xlsm ise KOD içinde ilgili satırı bulum onu da xlsm yapmanız lazım.)
Projeler.xlsm isimli yeni excel dosyanız aynı klasörde olacaklar

Aşağıdkai kodu Projeler isimli yeni excelinizin içine bir modüle ekleyip çalıştırırsınız.
Satır/Sütun hücre formatlarıı düzenleyebileceğinizi düşünerek bir şey yapmadım.

Not : Tek endişem listenizdeki proje sayısının excel sayfa sayısını zorlamaması

C++:
Sub ProjeleriAl_ADO()
    Dim xAdoBaglanti   As Object, xRecordSet As Object, xSqlSorgu As String, xAdoKaynak As String, xZaman As Double
    Dim ArrSayfalar As Variant, Baslık As Variant, i As Integer, x As Integer
    
    xZaman = Timer
    Set xAdoBaglanti = CreateObject("ADODB.Connection")
    Set xRecordSet = CreateObject("ADODB.Recordset")
    
    xAdoKaynak = ThisWorkbook.Path & Application.PathSeparator & "projelere göre yevmiye raporu.xlsx"
    xAdoBaglanti.Provider = "Microsoft.ACE.OLEDB.12.0"
    xAdoBaglanti.Properties("Data Source") = xAdoKaynak
    xAdoBaglanti.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
    xAdoBaglanti.Open
    
    xSqlSorgu = "Select Distinct [PROJE NO] from[DATA$] order by [PROJE NO] "
    xRecordSet.Open xSqlSorgu, xAdoBaglanti, 1, 1
    If xRecordSet.RecordCount = 0 Then GoTo SON
    ArrSayfalar = xRecordSet.getrows
    For i = LBound(ArrSayfalar, 2) To UBound(ArrSayfalar, 2)
        xRecordSet.Close
        For Each Sayfa In Worksheets
            If Sayfa.Name = ArrSayfalar(0, i) Then: Sheets(ArrSayfalar(0, i)).Cells.Clear: GoTo SayfaVar
        Next Sayfa
        Worksheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = ArrSayfalar(0, i)
SayfaVar:
        xSqlSorgu = "Select * from[DATA$] Where[PROJE NO]= '" & ArrSayfalar(0, i) & "'"
        xRecordSet.Open xSqlSorgu, xAdoBaglanti, 1, 1
        x = 0
        For Each Baslık In xRecordSet.Fields
            x = x + 1
            Sheets(ArrSayfalar(0, i)).Cells(1, x) = Baslık.Name
        Next Baslık
        Sheets(ArrSayfalar(0, i)).Range("A2").CopyFromRecordset xRecordSet
    Next i
SON:
    MsgBox "İşlem Tamamlandı" & Chr(10) & "Süre : " & Format(Timer - xZaman, "0.00") & " Saniye"
Set xRecordSet = Nothing: Set xAdoBaglanti = Nothing:
End Sub
 

Ekli dosyalar

Katılım
15 Ocak 2019
Mesajlar
229
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
06-03-2024
Merhaba,

Linki inceleyiniz. Linkte sizinde mesajınız varmış. :)


Hocam, bunu sizinde belirttiğiniz üzere incelemiştim fakat,
Örnekte tek şarta bağlı bir makro var. Benim 2 şart olunca çalıştıramadım.
makro bilgim hiç olmadığından, verdiğiniz linkteki makroları düzeltme şansım olmadı malasef.
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Tarihe göre sorguyu unutmuşum.
Onu da ekledim.
Sayfa1 de B3 hücresine tarih belirtip ve butona basarak çalıştırabilirsin
 

Ekli dosyalar

Katılım
15 Ocak 2019
Mesajlar
229
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
06-03-2024
Tarihe göre sorguyu unutmuşum.
Onu da ekledim.
Sayfa1 de B3 hücresine tarih belirtip ve butona basarak çalıştırabilirsin
hocam; öncelikle ilgiliniz için teşekkür ederim.
Fakat bu şekilde bir hata mesajı alıyorum.

230135
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Verilerin alınacağı dosya adı ve yolu doğru mu?

Adı: "projelere göre yevmiye rapor.xlsx"
Yol: Aynı klasör altındfa olacaklar
 
Katılım
15 Ocak 2019
Mesajlar
229
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
06-03-2024
Verilerin alınacağı dosya adı ve yolu doğru mu?

Adı: "projelere göre yevmiye rapor.xlsx"
Yol: Aynı klasör altındfa olacaklar
Hocam, dediğinizi yapınca oldu, teşekkürler.
Fakat data belirtilen hücre biçimleri gelmiyor. Hatalı geliyor.
Birde tek tek tarih yerine, nekadar tarih var ise, ayrı dosyaya oluşturma yapılabilirmi.

230136
 

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Verileri aldığınız dosyada saat olan sütunlarınızın formatını ss:mm olarak değiştirin
 
Üst