• DİKKAT

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

  • MÜJDE!!!! EXCEL WEB TR Adminlerinden Online EXCEL Seminerleri

    Online eğitimlere başlamadan önce sizlerin görüşlerini almak istiyoruz. Lütfen aşağıdaki konuda görüşlerinizi paylaşır mısınız... TEŞEKKRÜR EDERİZ

    ONLİNE EĞİTİM ANKETİ

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

com5

Altın Üye
Katılım
15 Ocak 2019
Mesajlar
210
Excel Vers. ve Dili
Office 365
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
33,441
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Merhaba,

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

 

ÖmerFaruk

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
2,302
Excel Vers. ve Dili
Ofis 365 Türkçe
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

com5

Altın Üye
Katılım
15 Ocak 2019
Mesajlar
210
Excel Vers. ve Dili
Office 365
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

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
2,302
Excel Vers. ve Dili
Ofis 365 Türkçe
Tarihe göre sorguyu unutmuşum.
Onu da ekledim.
Sayfa1 de B3 hücresine tarih belirtip ve butona basarak çalıştırabilirsin
 

Ekli dosyalar

ÖmerFaruk

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
2,302
Excel Vers. ve Dili
Ofis 365 Türkçe
Verilerin alınacağı dosya adı ve yolu doğru mu?

Adı: "projelere göre yevmiye rapor.xlsx"
Yol: Aynı klasör altındfa olacaklar
 

com5

Altın Üye
Katılım
15 Ocak 2019
Mesajlar
210
Excel Vers. ve Dili
Office 365
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

Altın Üye
Katılım
22 Ekim 2017
Mesajlar
2,302
Excel Vers. ve Dili
Ofis 365 Türkçe
Verileri aldığınız dosyada saat olan sütunlarınızın formatını ss:mm olarak değiştirin
 
Üst