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