• DİKKAT

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

Makronun Geliştirilmesi

N

nurluali

Katılım
19 Ocak 2012
Mesajlar
175
Excel Vers. ve Dili
Ağırlıklı olara 2003,2007,2010
NOT : İlgili sınıflardaki veriler tamamen değiştirilmiş olup. Özel Bilgi İçermemektedir.
e-okuldan künye defteri diye bir rapor mevcut bu raporu excel (sadece veri) şeklinde sınıf sınıf alıyorum buradaki veriler her öğrenci için 30 satılık veri mevcut bu verileri her öğrenciye bir satır olarak Ekli belgede 3 mödülde okuma, kopyalama ve temizleme makrosu mevcut. 35-40 sınıfa tek tek sheet1'e tüm çalışma kitabı olarak yapıştırıp sheet2 de ise okutup kopyalayarak manuel olarak değerleri yapıştır şeklinde Okuma sayfasına yapıştırıyorum. bu işlemi tüm sınıflar bitinceye kadar tekrarlayarak öğrencilere ait bilgileri kullanılbilir hale getiriyorum. Burada istediğim sheet1 e her yapıştırdığım sınıfı okuyarak sheet2 de başka yere kopyalama olmadan alt alta tüm sınıfların bilgilerini alması örnekte olduğu gibi her sınıf için kopyala değerleri yapıştır işlemini ortadan kaldırarak 1 kerede yapmak için makro mümkün mü? İlgilenecek arkadaşlara peşinen teşekkürlerimi sunuyorum.
 

Ekli dosyalar

Aşağıdaki gibi dener misiniz? Mark her sayfanın A1 hücresini kontrol eder, eğer A1'in ilk 7 karakteri ÖĞRENCİ ise o sayfada sizin eskiden yazdığınız kodları çalıştırır:
PHP: 
Sub Makro3()

say = 0
For sayfa = 1 To Sheets.Count
    If Left(Sheets(sayfa).[A1], 7) = "ÖĞRENCİ" Then
        For i = 0 To 4050 Step 30
            say = say + 1
            Cells(say + 2, 1) = "=Sheet1!E" & i + 2 'NUMARA
            Cells(say + 2, 2) = "=Sheet1!E" & i + 5 'TC
            Cells(say + 2, 3) = "=Sheet1!E" & i + 3 'ADI
            Cells(say + 2, 4) = "=Sheet1!E" & i + 4 'SOYADI
            Cells(say + 2, 5) = "" '"=Sheet1!E" & i + 13 'SINIFI
            Cells(say + 2, 6) = "" '"=Sheet1!E" & i + 13 'ALAN
            Cells(say + 2, 7) = "=Sheet1!E" & i + 6 'BABA
            Cells(say + 2, 8) = "=Sheet1!E" & i + 7 'ANA
            Cells(say + 2, 9) = "=Sheet1!E" & i + 8 'D.YERİ TARİHİ
            Cells(say + 2, 10) = "=Sheet1!E" & i + 9 'İL İLÇE
            Cells(say + 2, 11) = "=Sheet1!E" & i + 10 'MAH-KÖY
            Cells(say + 2, 12) = "=Sheet1!E" & i + 11 'CİLT
            Cells(say + 2, 13) = "=Sheet1!E" & i + 12 'AİLE SIRA
            Cells(say + 2, 14) = "=Sheet1!E" & i + 13 'SIRA NO
            Cells(say + 2, 15) = "=Sheet1!E" & i + 14 'VERİLDİĞİ YER
            Cells(say + 2, 16) = "" '"=Sheet1!E" & i + 13 'KAYIT NO
            Cells(say + 2, 17) = "" ' "=Sheet1!E" & i + 13 'VER NEDENİ VE TARİHİ
            Cells(say + 2, 19) = "=Sheet1!E" & i + 18 'GELDİĞİ OKUL
            Cells(say + 2, 20) = "=Sheet1!E" & i + 19 'GELDİĞİ OKUL
            Cells(say + 2, 21) = "=Sheet1!E" & i + 20 'GELDİĞİ OKUL
            Cells(say + 2, 22) = "=Sheet1!E" & i + 21 'GELDİĞİ OKUL
            Cells(say + 2, 23) = "=Sheet1!E" & i + 22 'GELDİĞİ OKUL
            Cells(say + 2, 24) = "=Sheet1!E" & i + 23 'GELDİĞİ OKUL
            Cells(say + 2, 25) = "=Sheet1!E" & i + 24 'GELDİĞİ OKUL
            Cells(say + 2, 26) = "=Sheet1!E" & i + 25 'GELDİĞİ OKUL
            Cells(say + 2, 27) = "=Sheet1!E" & i + 26 'GELDİĞİ OKUL
            Cells(say + 2, 28) = "=Sheet1!E" & i + 27 'GELDİĞİ OKUL
            Cells(say + 2, 29) = "=Sheet1!E" & i + 28 'GELDİĞİ OKUL
            Cells(say + 2, 30) = "=Sheet1!E" & i + 29 'GELDİĞİ OKUL
        Next
   End If
Next
End Sub
 
Yusuf Bey ilginize çok teşekkür ediyorum sağ olun var olun. Galiba ben sorunu tam izah edemedim. 20-30 tane sınıfı ayrı ayrı künyesini sadece excel veri olarak kaydedip shhet1 satır-sütun kesim noktasından tüm çalışma kitabını seçerek yapıştırıp sonra sheet2 de okutup kopyalayarak başka sayfaya değerleri yapıştır ile her öğrencinin bilgileri tek satırda alıyorum. bu işlemi her sınıf için tekrarlıyorum. sizin makroyu çalıştırdım. her sınıfı okuması 2-3 dak. sürüyor. ikinci bir hususta hep ilk yapıştırdığım sınıfın bilgilerini okuyor. 5 tane sınıf yaptım. hep ilk yaptığım sınıfın bilgilerini 5 defa okumuş ve sheet2 ye yazmış.
 
Günaydın. Kusura bakmayın. Önceki cevabımı denemeden yazmıştım. Verilerin hangi sayfadan alınacağı bilgisini eklemek gerekiyordu. Aşağıdaki gibi deneyiniz:

PHP: 
Sub okuma()
say = 0
For sayfa = 1 To Sheets.Count
    If Left(Sheets(sayfa).[A1], 7) = "ÖĞRENCİ" Then
        For i = 0 To 4050 Step 30
            say = say + 1
            Cells(say + 2, 1) = Sheets(sayfa).Range("E" & i + 2) 'NUMARA
            Cells(say + 2, 2) = Sheets(sayfa).Range("E" & i + 5) 'TC
            Cells(say + 2, 3) = Sheets(sayfa).Range("E" & i + 3) 'ADI
            Cells(say + 2, 4) = Sheets(sayfa).Range("E" & i + 4) 'SOYADI
            Cells(say + 2, 5) = "" 'sheets(sayfa).range("E" & i + 13) 'SINIFI
            Cells(say + 2, 6) = "" 'sheets(sayfa).range("E" & i + 13) 'ALAN
            Cells(say + 2, 7) = Sheets(sayfa).Range("E" & i + 6) 'BABA
            Cells(say + 2, 8) = Sheets(sayfa).Range("E" & i + 7) 'ANA
            Cells(say + 2, 9) = Sheets(sayfa).Range("E" & i + 8) 'D.YERİ TARİHİ
            Cells(say + 2, 10) = Sheets(sayfa).Range("E" & i + 9) 'İL İLÇE
            Cells(say + 2, 11) = Sheets(sayfa).Range("E" & i + 10) 'MAH-KÖY
            Cells(say + 2, 12) = Sheets(sayfa).Range("E" & i + 11) 'CİLT
            Cells(say + 2, 13) = Sheets(sayfa).Range("E" & i + 12) 'AİLE SIRA
            Cells(say + 2, 14) = Sheets(sayfa).Range("E" & i + 13) 'SIRA NO
            Cells(say + 2, 15) = Sheets(sayfa).Range("E" & i + 14) 'VERİLDİĞİ YER
            Cells(say + 2, 16) = "" '"sheets(sayfa).range("E" & i + 13) 'KAYIT NO
            Cells(say + 2, 17) = "" ' "sheets(sayfa).range("E" & i + 13) 'VER NEDENİ VE TARİHİ
            Cells(say + 2, 19) = Sheets(sayfa).Range("E" & i + 18) 'GELDİĞİ OKUL
            Cells(say + 2, 20) = Sheets(sayfa).Range("E" & i + 19) 'GELDİĞİ OKUL
            Cells(say + 2, 21) = Sheets(sayfa).Range("E" & i + 20) 'GELDİĞİ OKUL
            Cells(say + 2, 22) = Sheets(sayfa).Range("E" & i + 21) 'GELDİĞİ OKUL
            Cells(say + 2, 23) = Sheets(sayfa).Range("E" & i + 22) 'GELDİĞİ OKUL
            Cells(say + 2, 24) = Sheets(sayfa).Range("E" & i + 23) 'GELDİĞİ OKUL
            Cells(say + 2, 25) = Sheets(sayfa).Range("E" & i + 24) 'GELDİĞİ OKUL
            Cells(say + 2, 26) = Sheets(sayfa).Range("E" & i + 25) 'GELDİĞİ OKUL
            Cells(say + 2, 27) = Sheets(sayfa).Range("E" & i + 26) 'GELDİĞİ OKUL
            Cells(say + 2, 28) = Sheets(sayfa).Range("E" & i + 27) 'GELDİĞİ OKUL
            Cells(say + 2, 29) = Sheets(sayfa).Range("E" & i + 28) 'GELDİĞİ OKUL
            Cells(say + 2, 30) = Sheets(sayfa).Range("E" & i + 29) 'GELDİĞİ OKUL
        Next
   End If
Next
End Sub
 
Yusuf Bey; Öncelikle iyi akşamlar diler tekrar teşekkürlerimi sunarım.
Sub okuma() dan sonrasını kopyalayarak modül 3 deki makro(3) ün altına yapıştırdım. sheet1' e ilk sınıfı yapıştırıp okuttum ilk sınıfta problem yok fakat başka bir sınıfı sheet1'e yapıştırıp sheet2 de okuttuğumda yine A3 satırından başlayarak yeni sınıfı eskisinin üzerine yazdığını gördüm. Benim yapmak istediğim sheet2 de her sınıfı öncekinden (50- 100 satır) sonraya yazması.
 
Ben her sınıfın listesinin ayrı sayfalarda olacağını düşünerekmakroyu hazırlamıştım.

Eğer sadece Sheet1'den sheet2'ye veri almak istiyorsanız aşağıdaki makroyu deneyiniz:

PHP: 
Sub okuma()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")

        For i = 0 To 4050 Step 30
            say = s2.Cells(Rows.Count, "A").End(3).Row + 1
            s2.Cells(say, 1) = s1.Range("E" & i + 2) 'NUMARA
            s2.Cells(say, 2) = s1.Range("E" & i + 5) 'TC
            s2.Cells(say, 3) = s1.Range("E" & i + 3) 'ADI
            s2.Cells(say, 4) = s1.Range("E" & i + 4) 'SOYADI
            s2.Cells(say, 5) = "" 's1.range("E" & i + 13) 'SINIFI
            s2.Cells(say, 6) = "" 's1.range("E" & i + 13) 'ALAN
            s2.Cells(say, 7) = s1.Range("E" & i + 6)  'BABA
            s2.Cells(say, 8) = s1.Range("E" & i + 7)  'ANA
            s2.Cells(say, 9) = s1.Range("E" & i + 8)  'D.YERİ TARİHİ
            s2.Cells(say, 10) = s1.Range("E" & i + 9)  'İL İLÇE
            s2.Cells(say, 11) = s1.Range("E" & i + 10)  'MAH-KÖY
            s2.Cells(say, 12) = s1.Range("E" & i + 11)  'CİLT
            s2.Cells(say, 13) = s1.Range("E" & i + 12)  'AİLE SIRA
            s2.Cells(say, 14) = s1.Range("E" & i + 13)  'SIRA NO
            s2.Cells(say, 15) = s1.Range("E" & i + 14)  'VERİLDİĞİ YER
            s2.Cells(say, 16) = ""  '"s1.range("E" & i + 13) 'KAYIT NO
            s2.Cells(say, 17) = ""  ' "s1.range("E" & i + 13) 'VER NEDENİ VE TARİHİ
            s2.Cells(say, 19) = s1.Range("E" & i + 18)  'GELDİĞİ OKUL
            s2.Cells(say, 20) = s1.Range("E" & i + 19)  'GELDİĞİ OKUL
            s2.Cells(say, 21) = s1.Range("E" & i + 20)  'GELDİĞİ OKUL
            s2.Cells(say, 22) = s1.Range("E" & i + 21)  'GELDİĞİ OKUL
            s2.Cells(say, 23) = s1.Range("E" & i + 22)  'GELDİĞİ OKUL
            s2.Cells(say, 24) = s1.Range("E" & i + 23)  'GELDİĞİ OKUL
            s2.Cells(say, 25) = s1.Range("E" & i + 24)  'GELDİĞİ OKUL
            s2.Cells(say, 26) = s1.Range("E" & i + 25)  'GELDİĞİ OKUL
            s2.Cells(say, 27) = s1.Range("E" & i + 26)  'GELDİĞİ OKUL
            s2.Cells(say, 28) = s1.Range("E" & i + 27)  'GELDİĞİ OKUL
            s2.Cells(say, 29) = s1.Range("E" & i + 28)  'GELDİĞİ OKUL
            s2.Cells(say, 30) = s1.Range("E" & i + 29)  'GELDİĞİ OKUL
        Next
End Sub
 
Çok teşekkür ediyor ve iyi akşamlar diliyorum. Elinize sağlık istediğim olmuş. Şimdi tekrar 30 şubeyi alarak deneyeceğim.
Sub okuma()'yı kabul etmiyor faka Makro3() adından sonra kodları yapıştırdım ve istediğim sonuç alındı galiba bir durumla karşılaşırsam tekrar size dönerim.
Selam ve Saygılarımla
 
Yusuf Bey tekrar iyi akşamlar. 35 sınıfa ait tüm künyeleri tekrar aldım ve her şubeyi kontrol ettim herhangi bir problem çıkmadı yapmak istediğim çalışma sayenizde tam oldu. Elinize emeğinize sağlık teşekkür ediyorum.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst