• DİKKAT

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

Ayrı Excel Dosyalarından Veri almak ?

Katılım
1 Kasım 2006
Mesajlar
49
Excel Vers. ve Dili
Office 2003 - XP - Türkçe
Ek'teki dosyada forum üstadları ile oluşturmuş olduğumuz dosyalar var. Klasör içinde 1.HAFTA 2.HAFTA 3.HAFTA 4.HAFTA .xls dosyaları ve AYLIK TOPLAM.xls dosyası var

4 haftanın ÖĞRENCİLER sekmesindeki öğrenci toplamını macro ile AYLIK TOPLAM.xls dosyasına otomatik Aktarma yapılabilirliği varmıdır ?

Yani AYLIK TOPLAM.xls dosyasındaki AKTAR tuşuna bastığımızda 4 haftalık öğrencilerin ders saat toplamını alacak. Mükerrer öğrencileri birleştirecek (saatleriyle birlikte)


Bu yöntemi öğrenirsem, bende AYLIK toplamları 1 YILLIK dosyasında kendim yapacağım :) bi öğrensem şunu çok mutlu olacam :)

:)
 
Merhaba,

Haftalık dosyaların "Öğrenciler" sayfasının sütun başlıklarını değiştirmeniz gerekiyor.

Ben "ALAN1" ve "ALAN2" olarak isimlendirdim. Bunların hemen altına veri girilecek şekilde düşündüm. Bu şekilde yaparsanız aşağıdaki prosedur isteğinizi yapacaktır.

Kod:
Sub ADO_Aktar()
Dim cn As Object, rs As Object
Dim i As Byte, son As Long, arr()
 
arr = Array( _
"1.HAFTA.xls", "2.HAFTA.xls", "3.HAFTA.xls", "4.HAFTA.xls")
 
    For i = 0 To UBound(arr)
 
        Set cn = CreateObject("ADODB.Connection")
 
        cn.Open _
        "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
                ThisWorkbook.Path & "\" & arr(i)
 
        Set rs = cn.Execute( _
        "SELECT DISTINCT ALAN1, Sum(ALAN2) FROM [ÖĞRENCİLER$] GROUP BY ALAN1")
 
        son = Sheets("ÖĞRENCİLER").[a65000].End(3).Row + 1
 
        Sheets("ÖĞRENCİLER").Cells(son, "a").CopyFromRecordset rs
 
        rs.Close
        cn.Close
 
    Next
 
Set rs = Nothing
Set cn = Nothing
 
End Sub
 
Son düzenleme:
anemos üstad sütun başlıkları derken, A1 ve B1 hücrelerindeki yazılarımı diyorsun ?

BÜTÜH HAFTALARDA ÖĞRENCİLER SEKMESİNİN A1 VE B1 HÜCRELERİNE ALAN1 VE ALAN2 YAZDIM. AMA AKTARMA YAPMADI "Ölçüt ifadesinde veri uyuşmazlığı" hatası veriyor. sadece AYLIK TOPLAM.xls dosyasına ayarlayabilirmisin ? Bunu yıllığa ben çevirecemde mantığıda anlayım :)

Saygılarımla :)
 
Evet, aynı zamanda A2 ve B2 başlıklarını da silmelisiniz. Yani,

A1= ALAN1,
B1= ALAN2 (Test ettikten sonra isimleri değiştirebilirsiniz.)
Sonraki tüm satırlar veri alanı olarak kullanılmalı.
 
Örneğinizin uygulanmış hali ektedir.
 
anemos üstadım çok teşekür ederim, projeme son vuruşu sen yaptın :) herşey tamtıkır oldu şimdi :)

Umarım bir gün bende sizin gibi olurum =)

Saygılar, sevgiler. . .
 
excelde etiket yapmak

ya excel de etiket yapmak istiyorum otomatik nasıl yapabilirim
cvp yazrasanız sevinirim
]
 
şimdi verileri girmeye başladım ve bir hata buldum. 1.HAFTA ya öğrencileri ve saatlerini girdim, 2. haftayada girdim 3. haftaya geçtim. bir toplama yaptırayım dedim. 1 ve 2. haftada öğrencileri aktardım kaydettim. AYLIK TOPLAM dosyasına girdim ÖĞRENCİLERİ AKTARDIM.

1. Haftayı ayrı listeliyor 1 boşluk bırakıyor 2.Haftayı ayrı listeliyor. 1. haftada Leyla TOSUN var 2. Haftadada Leyla TOSUN var (mükerrerleri toplamıyor )
 
Test edin.

Kod:
Sub ADO_Aktar()
Dim cn As Object, rs As Object
Dim Sh As Worksheet, i As Byte, son As Long, arr()
 
Sheets("ÖĞRENCİLER").[a3:b65000].ClearContents
 
arr = Array( _
"1.HAFTA.xls", "2.HAFTA.xls", "3.HAFTA.xls", "4.HAFTA.xls")
 
    Application.ScreenUpdating = False
 
    'Geçici sayfa: "Temp"
    Set Sh = Worksheets.Add(After:=Sheets(Sheets.Count))
    Sheets(Sheets.Count).Name = "Temp"
 
    With Sheets("Temp")
 
       .[a1] = "ALAN1"
       .[b1] = "ALAN2"
 
       For i = 0 To UBound(arr)
 
           Set cn = CreateObject("ADODB.Connection")
 
           cn.Open _
           "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
                   ThisWorkbook.Path & "\" & arr(i)
 
           Set rs = cn.Execute( _
           "SELECT DISTINCT ALAN1, Sum(ALAN2) FROM [ÖĞRENCİLER$] GROUP BY ALAN1")
 
           son = .[a65000].End(3).Row + 1
 
           .Cells(son, "a").CopyFromRecordset rs
 
           rs.Close
           cn.Close
 
       Next
 
           'Geçici sayfada benzersiz toplamları tekrar sorgula.
           Set cn = CreateObject("ADODB.Connection")
 
           cn.Open _
           "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & _
                   ThisWorkbook.FullName
 
           Set rs = cn.Execute( _
           "SELECT DISTINCT ALAN1, Sum(ALAN2) FROM [Temp$] GROUP BY ALAN1")
 
           Sheets("ÖĞRENCİLER").[a3].CopyFromRecordset rs
 
           'Geçici sayfayı sil.
           Application.DisplayAlerts = False
           .Delete
           Application.DisplayAlerts = True
           Application.ScreenUpdating = True
 
           rs.Close
           cn.Close
 
    End With
 
Set Sh = Nothing
Set rs = Nothing
Set cn = Nothing
 
End Sub
 
Test sonucu olumlu =) Sağolasın üstad. Eline Emeğine sağlık, İlgin için teşekür ederim.
 
Geri
Üst