makroyla kenarlık ekleme neden uzun sürüyor ?

[nikomedian]

Merhaba, makroyla, verileri çektikten sonra bazı tabloların kenarlarında silinmeler oluyor. Makro kaydetme yöntemiyle ilk tablonun eksik kısımlarını çizdim ve döngü halinde 1 den 1780. hücreye kadar düzeltmesini sitedim yalnız, 1 dakikada ancak 5-10 hücre geçiyor, çok çok yavaş sebebi ne olabilir ? Yada bu durum normal mi?

 

[uzmanamele]

merhaba
1780 defa döndüreceğinize tablo aralığını tanımlayıp birdefada kenarlık çizdirseniz olmaz mı?

 

[nikomedian]

merhaba
1780 defa döndüreceğinize tablo aralığını tanımlayıp birdefada kenarlık çizdirseniz olmaz mı?

dediğinizi tam anlamadım ama zaten 19 'ar 19'ar atlayarak yapıyor.
Application.ScreenUpdating = False komutuyla denedim artık çok hızlı
İlginize teşekkür ederim yalnzı bir sorun var, kurduğum antığa göre a değerinin 19 19 artması gerekiyor ama böyle değil, 20 21 22 diey artıyor, nerde yanlış yapmış olabilirim ?

Sub tablo_optimize()
Application.ScreenUpdating = False
Dim a, b, c As Integer
a = 1
b = 2
For a = 1 To 7580
Sheets("katalog").Select

Range("D" & a).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("M" & a).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("M" & a).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range("D" & a).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("D" & b).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Application.CommandBars("Borders").Visible = False
a = a + 19
b = b + 19
Next a
End Sub

 

[uzmanamele]

her defasında hücre seçimi yapıyorsa, her seçimde hesap yapıyordur.
aşağıdaki şekilde deneyin

kenarlık çizdirme kodlarınızın başına
Application.Calculation = xlCalculationManual
kenarlık çizme işlemi bittikten sonra kodların sonuna
Application.Calculation = xlCalculationAutomatic

 

[uzmanamele]

merhaba
For a = 1 To 7580 Step 19
şeklinde deneyin

 

[nikomedian]

çok teşekkürler yalnız üstteki yazdığımı okursanız sevinirim, bir döngü hatam oluştu.

 

[uzmanamele]

merhaba
aşağıdaki şekilde denerseniz
a=a+19 demenize gerek yokki, o satırı silin.
For a = 1 To 7580 Step 19

 

[nikomedian]

Hocam çok teşekkür ederim, işe yaradı, bu komutu öğrendiğim de çok iyi oldu.