Soru veri tablosundaki bilgilerin mah sayfasına özet olarak aktarımı hk.

Katılım
18 Şubat 2013
Mesajlar
51
Excel Vers. ve Dili
excel 2019 türkçe dil
merhaba, ekteki örnek dosyada bi veri sayfam var dışarıdaki klasörün içinden başlıklar aynı ama konuların farklı olduğu dosyalardan verileri çekiyorum.
her mahallenin verisi örnekte olduğu gibi kendi sayfasına gidecek şekilde nasıl bir makro yapılabilir veya bir formül yazılabilir. veri sayfasında hem müd,ürlükler hem konular artabilir de azalabilir de. örnek mah olduğu gibi her müdürlüğün özeti bittikten sonra 1 satır boşluk bırakmasını istiyorum.
yardımcı olabilirseniz sevinirim.
saygılarımla...
 

Ekli dosyalar

Katılım
18 Şubat 2013
Mesajlar
51
Excel Vers. ve Dili
excel 2019 türkçe dil
Merhaba Derdimi anlatamadım mı, yoksa yardımcı olabilecek yok mu
 

Korhan Ayhan

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

Biçim olarak aşağıdaki gibi aktarılsa sorun olur mu?

221178
 
Katılım
18 Şubat 2013
Mesajlar
51
Excel Vers. ve Dili
excel 2019 türkçe dil
hocam müdürlüklerin konuların üstünde olması birde her müdürlük değişiminde 1 satır boşluk bırakması benim için bulunmaz bir şey olur. çok mutlu olurum.
saygılarımla...
 
Katılım
18 Şubat 2013
Mesajlar
51
Excel Vers. ve Dili
excel 2019 türkçe dil
hocam örnekte olduğu gibi hata verdi.
yani Bağbaşı olan mahallede aaaa müdürlük ve altında konu olmadığı halde müdürlük ismini de aktardı, bu hata peşine gelen yusfu ve hasan mahalleleri içinde geçerli, sadece en son sayfa olan Hüseyin doğru gelmiş.
müdürlük sayıları artabilir azalabilir aynı şey konular içinde geçerli, eğer müdürlük altında konu bilgisi yoksa müdürlük ismi aktarılmasın.

birde hocam aktarımda ilgili sayfa içinde başka hücrelerde bilgi varsa o bilgilerde siliniyor. sadece b, c ve d hücresinin ve verilerinin başlama satırı ve bitiş satırı geçerli olma durumu var mı,
hocam biliyorum çok olmuyor ama elimden gelmediği için böyleyim.
saygılarımla...
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
#7 nolu mesajımda ki dosyayı revize ettim.

Bir önceki sürümde sayfaları silip yeniden oluşturuyordu. Bu durum düzeltildi. Var olan sayfalarda B-C-D sütun içerikleri dışında sayfalarda bir silme işlemi olmamaktadır. Eğer Mahalle sayfası yoksa eklenerek aktarım yapılmaktadır.
 
Katılım
18 Şubat 2013
Mesajlar
51
Excel Vers. ve Dili
excel 2019 türkçe dil
hocam çok çok teşekkür ederim tam istediğim gibi aktarım oldu. elinize sağlık.
sadece benim plansız düşünmem yüzünden bi sorunun var. örnek dosyayı gönderirken orijinal başlık serisini hesap edemedim sadece aktarım olacak başlıkları gönderdiğim için biraz çuvalladım.
Utanarak yazıyorum, Zamanınız varsa ekteki gibi revize etme durumunuz olur mu,
olmasa sağlık olsun...
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Yardımcı olmak isteyen tüm üyeler defalarca örnek dosya talebinde bulunuyoruz. Bunu talep ederken yapısal olarak asıl dosyalarla benzerlik göstermesini bekliyoruz. Ama ben bu sorunu sürekli yaşıyorum. Bir noktadan sonra bu durum gerçekten çok can sıkıcı olabiliyor ve gerçekten cevap verme hevesimiz kırılıyor.

Senaryo genelde şu şekilde gerçekleşiyor;

Örnek dosya ekleniyor. Yardımcı olmak isteyenler tarafından çözüm öneriliyor. Sonrasında benim dosyam şöyle değildi böyleydi diyerek konular gereksiz yere uzayıp gidiyor. Bunun yanı sıra gereksiz zaman kaybı yaşanıyor.


Cevap arayan üyelerimiz bunu genellikle öğrenmek için yapıyorlar. Eğer bir dosyadaki kod ile makro yazmak öğrenilseydi bizlerin uzaya çıkması gerekirdi. Öğrenmek için çok araştırma yapılması gerekir. İşin temelinden başlamak her zaman daha verimlidir. Bol pratik yapılması gerekir. Kişisel gelişim için ofis programlarını öğrenmek önemli ise gerekiyorsa kursa gidilmelidir. Keşke Matrix filmindeki gibi bilmediğimiz işleri bizlere bilgisayara yükler gibi yükleyebilselerdi. O zaman bir el şıklatması ile birçok şeyi kolaylıkla öğrenebilirdik.
 
Katılım
18 Şubat 2013
Mesajlar
51
Excel Vers. ve Dili
excel 2019 türkçe dil
hocam zaman ayırıp yardımcı olduğunuz için emeğinize sağlık. yaptığınız şey benim için bulunmaz bir şeydi.
saygılarımla...
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Düzenlenmiş dosyanız ektedir.

Not : Umarım bir önceki mesajımda yazdıklarım bu başlığı okuyan diğer üyelerimize de örnek olur.
 

Ekli dosyalar

Katılım
18 Şubat 2013
Mesajlar
51
Excel Vers. ve Dili
excel 2019 türkçe dil
Merhaba hocam, ilk örnek dosyada mahalle sütunu öndeydi orijinal başlıkları gönderdiğim örnek dosyada müdürlükler mahalle sütunundan öne aldım o yüzden müdürlük isimleri mahalle isminde geliyor acaba düzeltme durumunuz olur mu
Saygılarımla...
 

Ekli dosyalar

Korhan Ayhan

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

C++:
Option Explicit

Sub Verileri_Sayfalara_Aktar()
    Dim Zaman As Double, S1 As Worksheet, Sayfa As Worksheet
    Dim Baglanti As Object, Kayit_Seti As Object
    Dim Mahalleler As Object, Mudurlukler As Object
    Dim Dosya As String, Sorgu As String, Satir As Long
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Veri Dosyası")
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    Set Mahalleler = CreateObject("AdoDb.Recordset")
    Set Mudurlukler = CreateObject("AdoDb.Recordset")
    
    Dosya = ThisWorkbook.FullName
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
            
    Sorgu = "Select Distinct F1 From [Veri Dosyası$E2:E] Order By F1 Asc"
    Mahalleler.Open Sorgu, Baglanti, 1, 1
            
    Sorgu = "Select Distinct F1 From [Veri Dosyası$D2:D] Order By F1 Asc"
    Mudurlukler.Open Sorgu, Baglanti, 1, 1
        
    Mahalleler.MoveFirst
        
    Do While Not Mahalleler.EOF
        On Error Resume Next
        Set Sayfa = Nothing
        Set Sayfa = Sheets(CStr(Mahalleler(0)))
        On Error GoTo 0
        If Sayfa Is Nothing Then
            Set Sayfa = Sheets.Add(, Sheets(Sheets.Count))
            Sayfa.Name = Left(Mahalleler(0), 31)
        End If
        
        Sayfa.Range("B2:D" & Sayfa.Cells(Sayfa.Rows.Count, 2).End(3).Row).Clear
        
        Sayfa.Range("C2") = Mahalleler(0)
        
        Mudurlukler.MoveFirst
    
        Do While Not Mudurlukler.EOF
            Sorgu = "Select F8,Sum(F10),F11 From [Veri Dosyası$A2:L] Where F5 = '" & Mahalleler(0) & "' And F4 = '" & Mudurlukler(0) & "' Group By F8,F11"
            Kayit_Seti.Open Sorgu, Baglanti, 1, 1
            If Kayit_Seti.RecordCount > 0 Then
                Satir = Sayfa.Cells(Sayfa.Rows.Count, 3).End(3).Row + 2
                Sayfa.Cells(Satir, 2) = Mudurlukler(0)
                Sayfa.Cells(Satir, 2).Font.Bold = True
                Satir = Satir + 1
                Sayfa.Cells(Satir, 2).CopyFromRecordset Kayit_Seti
                Sayfa.Cells(Satir, 2).Resize(Kayit_Seti.RecordCount).InsertIndent 1
            End If
            If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
            Mudurlukler.MoveNext
        Loop
        Sayfa.Columns.AutoFit
        Mahalleler.MoveNext
    Loop

    S1.Select

    Application.ScreenUpdating = True
        
    If Mahalleler.State <> 0 Then Mahalleler.Close
    If Mudurlukler.State <> 0 Then Mudurlukler.Close
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    
    Set S1 = Nothing
    Set Baglanti = Nothing
    Set Kayit_Seti = Nothing
    Set Mahalleler = Nothing
    Set Mudurlukler = Nothing
End Sub
 
Üst