• DİKKAT

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

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

I

isakaratastan

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

Merhaba,

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

221178
 
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...
 
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

#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.
 
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

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.
 
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...
 
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

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

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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst