Kod aşırı derecede yavaşladı

V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Arkadaşlar merhaba. Daha önce sizlerin yardımıyla hazırladığım bir dosyadaki kodlar çalışırken aşırı derecede yavaşladı. 2 dakika kadar süren işlem 10 dakikada ancak bitiyor.
Ben dosyaya çeşitli yazıcı kodları ekledim. onlardan mı nedir bilemiyorum?

https://dosya.co/qcoee1rxf9bc/OGRENCI_PROGRAMI_v4.xls.html

Yavaş çalışan Kod aşağıda:

Sub veri_sayfasına_kaydet()
Application.Calculation = XlCalculation.xlCalculationManual
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("OKUL LİSTE")
Set s2 = ThisWorkbook.Worksheets("VERİ")
yaz = 0
For i = 2 To s1.Range("r65536").End(xlUp).Row
If s1.Cells(i, "r") <> "" Then
sırası = 0: kayıtt = ""
sonsat = s2.Range("c65536").End(xlUp).Row + 1
sırası = WorksheetFunction.Match(s1.Range("r" & i).Value, s2.Range("c1:c" & sonsat), 0)
If sırası > 0 Then kayıtt = "üzerine"
If sırası = 0 Then kayıtt = "Yeni Kayıt"
If sırası = 0 Then sırası = s2.Range("c65536").End(xlUp).Row + 1
s2.Cells(sırası, 1) = sırası - 2 'sıra no
s2.Cells(sırası, 2) = s1.Cells(i, "q") 'sınıf-şube

s2.Cells(sırası, 3) = s1.Cells(i, "d") 'okul no
s2.Cells(sırası, 4) = s1.Cells(i + 1, "d") 'adı
s2.Cells(sırası, 5) = s1.Cells(i + 2, "d") 'soyadı
s2.Cells(sırası, 6) = s1.Cells(i + 3, "d") 'baba adı
s2.Cells(sırası, 7) = s1.Cells(i + 4, "d") 'anne adı
s2.Cells(sırası, 8) = s1.Cells(i + 5, "d") 'doğum yeri ve tarihi
s2.Cells(sırası, 9) = s1.Cells(i + 7, "d") 'T.C. kimlik no
s2.Cells(sırası, 10) = s1.Cells(i + 8, "d") 'İli
s2.Cells(sırası, 11) = s1.Cells(i + 9, "d") 'ilçesi
s2.Cells(sırası, 12) = s1.Cells(i + 10, "d") 'Mahalle köy
s2.Cells(sırası, 13) = s1.Cells(i + 7, "k") 'cilt no
s2.Cells(sırası, 14) = s1.Cells(i + 8, "k") 'aile sıra no
s2.Cells(sırası, 15) = s1.Cells(i + 9, "k") 'Sıra no
s2.Cells(sırası, 16) = s1.Cells(i + 16, "d")
s2.Range("a" & sırası & ":s" & sırası).Borders.LineStyle = xlContinuous
yaz = yaz + 1
End If
Next i
Application.Calculation = XlCalculation.xlCalculationAutomatic
If yaz >= 1 Then MsgBox yaz & "adet Veri VERİ sayfasına YAZILDI.", vbInformation
If yaz = 0 Then MsgBox "Yazdırılacak VERİ BULUNAMADI.", vbCritical
Sheets("OKUL LİSTE").[A3:R65500].ClearContents
End Sub
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Sayfalarda veri olmadığı için kesin çözüm sunamıyoruz. Ama aşağıdaki şekilde yazabilirsiniz. Az da olsa hızlanır.
Veri olursa toplu olarak kopyala yapıştır yapılabilir.Gerçek olmayan örnek veriler eklerseniz iki sayfaya da farklı çözüme bakarız.
Kod: 
Sub veri_sayfasına_kaydet()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = XlCalculation.xlCalculationManual
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("OKUL LİSTE")
Set s2 = ThisWorkbook.Worksheets("VERİ")
yaz = 0
For i = 2 To s1.Range("r65536").End(xlUp).Row
If s1.Cells(i, "r") <> "" Then
sırası = 0: kayıtt = ""
sonsat = s2.Range("c65536").End(xlUp).Row + 1
sırası = WorksheetFunction.Match(s1.Range("r" & i).Value, s2.Range("c1:c" & sonsat), 0)
If sırası > 0 Then kayıtt = "üzerine"
If sırası = 0 Then kayıtt = "Yeni Kayıt"
If sırası = 0 Then sırası = s2.Range("c65536").End(xlUp).Row + 1
s2.Cells(sırası, 1) = sırası - 2 'sıra no
s2.Cells(sırası, 2) = s1.Cells(i, "q") 'sınıf-şube

s2.Cells(sırası, 3) = s1.Cells(i, "d") 'okul no
s2.Cells(sırası, 4) = s1.Cells(i + 1, "d") 'adı
s2.Cells(sırası, 5) = s1.Cells(i + 2, "d") 'soyadı
s2.Cells(sırası, 6) = s1.Cells(i + 3, "d") 'baba adı
s2.Cells(sırası, 7) = s1.Cells(i + 4, "d") 'anne adı
s2.Cells(sırası, 8) = s1.Cells(i + 5, "d") 'doğum yeri ve tarihi
s2.Cells(sırası, 9) = s1.Cells(i + 7, "d") 'T.C. kimlik no
s2.Cells(sırası, 10) = s1.Cells(i + 8, "d") 'İli
s2.Cells(sırası, 11) = s1.Cells(i + 9, "d") 'ilçesi
s2.Cells(sırası, 12) = s1.Cells(i + 10, "d") 'Mahalle köy
s2.Cells(sırası, 13) = s1.Cells(i + 7, "k") 'cilt no
s2.Cells(sırası, 14) = s1.Cells(i + 8, "k") 'aile sıra no
s2.Cells(sırası, 15) = s1.Cells(i + 9, "k") 'Sıra no
s2.Cells(sırası, 16) = s1.Cells(i + 16, "d")
s2.Range("a" & sırası & ":s" & sırası).Borders.LineStyle = xlContinuous
yaz = yaz + 1
End If
Next i
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = XlCalculation.xlCalculationAutomatic
If yaz >= 1 Then MsgBox yaz & "adet Veri VERİ sayfasına YAZILDI.", vbInformation
If yaz = 0 Then MsgBox "Yazdırılacak VERİ BULUNAMADI.", vbCritical
Sheets("OKUL LİSTE").[A3:R65500].ClearContents
End Sub
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Sayın Askm ilgin için teşekkür ederim. Dosyada kullandığım veriler e okuldan aldığım öğrenci verileri olduğundan paylaşamıyorum. Ancak örnek olsun diye aynı formatta hayali iki öğrenci bilgisi yükledim. Okul listesi sayfasındaki bu bilgiler 2 kişilik. Gerçekte 1300 öğrenci bilgisi oluyor ve bu formatta oluyor. Sizin verdiğiniz kodları gerçek dosyada denedim. 14 dakika geçti hala işlem bitmemişti. Örnek verili dosya ekledim. Saygılar.

https://dosya.co/sz9jcl3pextz/OGRENCI_PROGRAMI_v4.xls.html
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,453
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki kodu deneyiniz.

İşlem süresi bende 1300 öğrenci için 2 saniye civarında tamamlandı.

Kod: 
Sub Verileri_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Liste As Variant, Son As Long, Zaman As Double
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Zaman = Timer
    
    Set S1 = ThisWorkbook.Worksheets("OKUL LİSTE")
    Set S2 = ThisWorkbook.Worksheets("VERİ")
    
    S2.Range("A3:T" & S2.Rows.Count).ClearContents
    S2.Range("A3:T" & S2.Rows.Count).NumberFormat = "General"

    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Liste = S1.Range("A2:Q" & Son).Value
    Satir = 3
    
    For X = 1 To UBound(Liste, 1) Step 21
        S2.Cells(Satir, 1) = Satir - 2
        S2.Cells(Satir, 2) = Liste(X, 16)
        S2.Cells(Satir, 3) = Liste(X, 4)
        S2.Cells(Satir, 4) = Liste(X + 1, 4) & " " & Liste(X + 2, 4)
        S2.Cells(Satir, 5) = Liste(X + 3, 4)
        S2.Cells(Satir, 6) = Liste(X + 4, 4)
        S2.Cells(Satir, 7) = CDate(Split(Trim(Replace(Liste(X + 5, 4), "   ", " ")), " ")(2))
        S2.Cells(Satir, 8) = Liste(X + 7, 4)
        S2.Cells(Satir, 9) = Liste(X + 8, 4)
        S2.Cells(Satir, 10) = Liste(X + 9, 4)
        S2.Cells(Satir, 11) = Liste(X + 10, 4)
        S2.Cells(Satir, 12) = Liste(X + 7, 11)
        S2.Cells(Satir, 13) = Liste(X + 8, 11)
        S2.Cells(Satir, 14) = Liste(X + 9, 11)
        S2.Cells(Satir, 15) = Liste(X + 16, 4)
        S2.Cells(Satir, 16) = Split(Trim(Replace(Liste(X + 5, 4), "   ", " ")), " ")(0)
        Satir = Satir + 1
    Next
    
    S2.Range("A3:T" & Satir - 1).Borders.LineStyle = xlContinuous
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox "Aktarım işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Sayın Korhan Ayhan Verdiğiniz kod hakikaten mükemmel çalıştı. Hatta sınıfları birleştirme makrosundan bile hızlı. 0,95 saniye mükemmel. Allah razı olsun.

Aynı dosyayla ilgili bir iki şey sorabilir miyim?

Öğrencilerin Doğum tarihi ve yeri bilgisi aynı hücrede olduğundan Veri sayfasına mesela PENDİK 23/04/2012 şeklinde tek hücreye aktarılıyor. Doğum tarihi ve yerini ben daha sonra başka bir sayfada ayırıp tekrar yapıştırıyorum. Aktarım yaparken Tarih kısmı ile Doğum Yeri ayrılabilir mi?

Birde bazı T.C kimlik noları aktarılırken bozuluyor. 20 30 tane kadar.O hücreler sanki hücreye sığmayan rakam gibi gözüküyor. hücreyi genişletsemde düzelmiyor. Veri sayfasına o hücreler aktarılmıyor. Ben herhangi bir boş hücreye tıklayıp biçim boyacısı ile bozuk hücreye tıklayınca normale dönüyor. Bunu önlemek için ne yapılabilir. Teşekkür ediyorum.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,453
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Doğum tarihi ve yerini normalde ayıracaktım. Fakat sizin tablonuzda birleşik olunca vardır bir sebebi deyip vazgeçtim. Şimdi dışardayım eve geçince bakarım.
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Aşağıdaki şekilde ayırabilirsiniz.
Kod: 
        Kelime = Split(Liste(X + 5, 4))
        DogumYeri = Kelime(0)
        DogumTarihi = Kelime(UBound(Kelime))
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Sayın Askm ilginize teşekkür ederim ama ben kod yazmayı bilmediğimden bu kodu nereye eklemeliyim.
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
S2.Cells(Satir, 7) = Liste(X + 5, 4)
satırı Doğum Yerini ve Tarihi birleşik yazıyor. Eğer bu alana doğum yerini yazmak istiyorsanız
S2.Cells(Satir, 7) = DoğumYeri yazmanız gerekir. Doğum tarihini de hangi sütuna denk gelecekse
S2.Cells(Satir, 8) = DoğumTarihi yazmanız yeterli
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Sayın Askm verdiğiniz bilgilerden anladığım kadarıyla koda aşağıdaki gibi ekledim. Ancak Doğum tarihi ve Doğum yeri yerine tüm öğrencilere 1. öğrencinin annesinin adını yazdı. Yani başaramadım.

https://dosya.co/3bztrkw9a45r/OGRENCI_PROGRAMI_v4.xls.html


Sub Verileri_Aktar()
Dim S1 As Worksheet, S2 As Worksheet
Dim Liste As Variant, Son As Long, Zaman As Double

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Zaman = Timer


Set S1 = ThisWorkbook.Worksheets("OKUL LİSTE")
Set S2 = ThisWorkbook.Worksheets("VERİ")


S2.Range("A3:T" & S2.Rows.Count).ClearContents
S2.Range("A3:T" & S2.Rows.Count).NumberFormat = "General"

Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
Liste = S1.Range("A2:Q" & Son).Value
Satir = 3

Kelime = Split(Liste(X + 5, 4))
DogumYeri = Kelime(0)
DogumTarihi = Kelime(UBound(Kelime))

For X = 1 To UBound(Liste, 1) Step 21
S2.Cells(Satir, 1) = Satir - 2
S2.Cells(Satir, 2) = Liste(X, 16)
S2.Cells(Satir, 3) = Liste(X, 4)
S2.Cells(Satir, 4) = Liste(X + 1, 4) & " " & Liste(X + 2, 4)
S2.Cells(Satir, 5) = Liste(X + 3, 4)
S2.Cells(Satir, 6) = Liste(X + 4, 4)
S2.Cells(Satir, 7) = DogumTarihi
S2.Cells(Satir, 8) = Liste(X + 7, 4)
S2.Cells(Satir, 9) = Liste(X + 8, 4)
S2.Cells(Satir, 10) = Liste(X + 9, 4)
S2.Cells(Satir, 11) = Liste(X + 10, 4)
S2.Cells(Satir, 12) = Liste(X + 7, 11)
S2.Cells(Satir, 13) = Liste(X + 8, 11)
S2.Cells(Satir, 14) = Liste(X + 9, 11)
S2.Cells(Satir, 15) = Liste(X + 16, 4)
S2.Cells(Satir, 16) = DogumYeri
Satir = Satir + 1
Next

S2.Range("A3:T" & Satir - 1).Borders.LineStyle = xlContinuous

Set S1 = Nothing
Set S2 = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

MsgBox "Aktarım işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
"İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Kelime kısmını döngü, dışında almışsınız.
Aşağıdaki şekilde revize edin.
Kod: 
Sub Verileri_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Liste As Variant, Son As Long, Zaman As Double
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
        
    Zaman = Timer
       
        
    Set S1 = ThisWorkbook.Worksheets("OKUL LİSTE")
    Set S2 = ThisWorkbook.Worksheets("VERİ")

        
    S2.Range("A3:T" & S2.Rows.Count).ClearContents
    S2.Range("A3:T" & S2.Rows.Count).NumberFormat = "General"
       
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Liste = S1.Range("A2:Q" & Son).Value
    Satir = 3
            
    For X = 1 To UBound(Liste, 1) Step 21
        S2.Cells(Satir, 1) = Satir - 2
        S2.Cells(Satir, 2) = Liste(X, 16)
        S2.Cells(Satir, 3) = Liste(X, 4)
        S2.Cells(Satir, 4) = Liste(X + 1, 4) & " " & Liste(X + 2, 4)
        S2.Cells(Satir, 5) = Liste(X + 3, 4)
        S2.Cells(Satir, 6) = Liste(X + 4, 4)
        Kelime = Split(Liste(X + 5, 4))
        DogumYeri = Kelime(0)
        DogumTarihi = Kelime(UBound(Kelime))
        S2.Cells(Satir, 7) = DogumTarihi
        S2.Cells(Satir, 8) = Liste(X + 7, 4)
        S2.Cells(Satir, 9) = Liste(X + 8, 4)
        S2.Cells(Satir, 10) = Liste(X + 9, 4)
        S2.Cells(Satir, 11) = Liste(X + 10, 4)
        S2.Cells(Satir, 12) = Liste(X + 7, 11)
        S2.Cells(Satir, 13) = Liste(X + 8, 11)
        S2.Cells(Satir, 14) = Liste(X + 9, 11)
        S2.Cells(Satir, 15) = Liste(X + 16, 4)
        S2.Cells(Satir, 16) = DogumYeri
        Satir = Satir + 1
    Next
    
    S2.Range("A3:T" & Satir - 1).Borders.LineStyle = xlContinuous
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox "Aktarım işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Sayın Askm. Çok teşekkür ediyorum. Söylediğiniz gibi gayet güzel çalıştı. Son bir ricam olsa. Bilgiler e okuldan aktarılırken doğum tarihlerinin bazıları

28/04/2013 şeklinde bazıları ise 6.11.2013 geliyor. Listelerde bu sütunu tarih olarak biçimlendirsem de değişen bir şey olmuyor. Bu tarihleri 6.11.2013 haline getirebilir miyiz? teşekkürler.
 
A

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Tarih kısmını DogumTarihi = Format(Kelime(UBound(Kelime)), "dd.mm.yyyy") şeklinde yazın.
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Sayın Aksm ve Sayın Korhan Ayhan çok teşekkür ediyorum. Emeğinize sağlık. Hayırlı geceler.
 
Korhan Ayhan

Korhan Ayhan

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

Ben cevap verene kadar sorun çözümlenmiş. Bende kendi mesajımda ki kodu revize ettim.

TC no ile ilgili durumu tam anlamadım. Veriler "OKUL LİSTE" sayfasında mı bozuk şekilde görünüyor. Yoksa VERİ sayfasında mı bozuk görünüyor.
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Verileri e kuldan öğrenci künye defteri bölümünden sınıf bazında excele aktarıyorum. Tüm okulun sınıf listelerini oluşturup 1A B.... bu dosya ile aynı klasöre koyuyorum. Sonra OKUL LİSTE Sayfasındaki kodu çalıştırıp sınıfları burada birleştiriyorum. Sonra sizin revize ettiğiniz kod ile VERİ Sayfasına aktarıyorum. VERİ sayfasında bazen TC NO gelmemiş öğrenciler olduğunu görünce OKUL LİSTE sayfasından niye aktarılmamış diye kontrol ediyorum. Hatta kodda aktarım yapıldıktan sonra OKUL LİSTE safasını temizleyen satırı kaldırdım. Çünkü aktarılmamış numaralar OKUL LİSTE sayfasında oluyor. Ama mausla hücre üzerine geldiğimde negatif sayı veya benzeri bir ifade vardı. rakamlar hücreye sığmayınca oluşan görüntü vardı. Hücreyi genişletmeme rağmen değişmedi. sanki sonsuz uzunlukta bir sayı gibi. Ben boş bir hücreye tıkladım. Sonra biçim boyacısı ile o boş hücrenin özelliklerini bozuk TC. Kimlik hücresine aktarınca sayı düzeldi. Tekrar aktar dediğimde VERİ sayfasına gitti.
Ben de içinde veri olmayan O Sütununu seçtim Biçim boyacısı ile D sütununa tıkladım . Bozuk hücreler düzeldi.

Bu işlemden sonra sayfaları temizleyip işlemleri tekrarladığımda eksik numara oluşmuyor.

Yukarıda revize ettiğiniz kodu dosyaya uyarladığımda Type Mismatch uyarısı geliyor ama kod çalışıyor.

Saygılar.
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,453
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bahsettiğiniz hücrenin ekran görüntüsünü paylaşırsanız daha iyi yorumlayabiliriz.

Kod hangi satırda hata veriyorsa onu da bildirin düzeltmeyi yapalım.
 
V

vurkan

Katılım
29 Haziran 2018
Mesajlar
297
Excel Vers. ve Dili
2016 TÜRKÇE
Bu hücreleri anlattığım yöntemle düzelttiğimden örnek bulamadım. Yeni aktardığım sınıflarda da oluşmadı. O yüzden örnek paylaşamıyorum. Üstadım izninizle dosyayla ilgili bir yardım istesem.
Yukarıdaki dosyaya yazıcı ve diğer düğmeleri yazıcı isimli bir sayfaya taşıdım. buradan toplu veya sınıf bazında çıktılar almak istiyorum. Bunun için aşağıdaki kodlarda düzenleme yapamadım. Bu kodlarla BRANŞ sayfasındaki S2:S4 aralığında formülle bulunan sınıf isimlerini 1. DÖNEM DİN sayfasındaki A2 hücresine sırayla yazıp yazıcıya gönderiyor. Bu kod bu haliyle dosyasında çalışıyor.

Sub KAZANIM_1()
Dim ws1 As Worksheet: Set ws1 = Sheets("BRANŞ")
Dim ws2 As Worksheet: Set ws2 = Sheets("1. DÖNEM DİN")
Dim say As Long: say = Application.WorksheetFunction.CountIf(Sheets("BRANŞ").Range("S2:S14"), "4*")
Dim i As Long
For i = 2 To say + 1
ws2.[A2] = ws1.Cells(i, "S")
ws2.PrintOut
Application.Wait (Now + TimeValue("0:00:01"))
Next i
End Sub

Benim yukarıdaki dosyamda yazıcıdan çıkmasını istediğim sınıfları SINIF sayfasında C2:C42 aralığına yazdım. Kodu ise;

Sub Aşı_1()
Dim ws1 As Worksheet: Set ws1 = Sheets("VERİ")
Dim ws2 As Worksheet: Set ws2 = Sheets("AŞI")
Dim say As Long: say = Application.WorksheetFunction.CountIf(Sheets("SINIF").Range("C2:C11"), "1*")
Dim i As Long
For i = 2 To say + 1
ws2.[A1] = ws1.Cells(i, "C")
ws2.PrintOut
Application.Wait (Now + TimeValue("0:00:01"))
Next i
End Sub

Yaptım. Ama boş liste aldım. Maksadım SINIF listesindeki 1. sınıfların adlarını sırayla AŞI sayfası A1 e yazdırıp çıktı almaktı. Ama boş liste alıyorum.

Tek sınıf çıktılarını ise YAZICI sayfasınnda L4 hücresine yazdığım sınıf ismi İlgili sayfanın A1 hücresine yazdırıp çıktı almak Yardımcı olursanız sevinirim.

https://dosya.co/t61bavv5goai/OGRENCI_PROGRAMI_v5.xls.html
 
Korhan Ayhan

Korhan Ayhan

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

Eklediğiniz dosyada sayfa adı "AŞI " şeklinde fakat siz kod içinde Sheets("AŞI") olarak tanımlamışsınız.

Kullandığınız döngüde değer 2. satırdan başlıyor fakat VERİ sayfasında verileriniz 3. satırdan başlıyor.

"Aşı_1" makrosunu foruma eklerken kod içinde ws1.Cells(i, "C") yazmışsınız fakat dosyanızda bu satırda "S" sütunundaki veriyi aldırmışsınız. Fakat bu sütun boş olduğu için işlem yapmıyor olabilir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst