listboxtan hücreye veri aktarırken daha hızlı nasıl olur.

[a_self_lion]

Selam arkadaşlar,
Aşağıdaki kodlarla Listbox daki verilerimi Excel sonuc Sayfama aktarıyorum Fakat 70 satırlık bir yeriyi çok yavaş akatarıyor. hele biraz yavaş bir bilgisayarda dahada yavaşlıyor ve kullanım işlevini azaltıyor.
Daha hızlı nasıl aktarabilrim. Bu verileri Excele Hücrelerinie.

Şimdiden teşekkür ederim.

Private Sub CommandButton2_Click()
Worksheets("SONUC").Select
Sheets("SONUC").Range("a3:P65536").ClearContents
Sheets("SONUC").Range("S3:T65536").ClearContents
a = ListBox1.ListCount
'aa = WorksheetFunction.CountA(Sheets(textBox4.Value).Ra nge("A:A"))
aa = WorksheetFunction.CountA(Sheets("SONUC").Range("A:A"))
For i = 1 To a
'Sheets(TextBox4.Value).Cells(i + 8, aa + 0) = ListBox1.Column(0, i - 1)  
 
bU ŞEKİLDE Textbox daki sayfa adını alıyor
'Sheets(TextBox4.Value).Cells(i + 8, aa + 1) = ListBox1.Column(1, i - 1)
'Sheets(TextBox4.Value).Cells(i + 8, aa + 2) = ListBox1.Column(2, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 0) = ListBox1.Column(0, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 1) = ListBox1.Column(1, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 2) = ListBox1.Column(2, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 3) = ListBox1.Column(3, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 4) = ListBox1.Column(4, i - 1) 'DV
Sheets("SONUC").Cells(i + 2, aa + 5) = ListBox1.Column(5, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 6) = ListBox1.Column(6, i - 1) 'AL
Sheets("SONUC").Cells(i + 2, aa + 7) = ListBox1.Column(7, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 8) = ListBox1.Column(8, i - 1) 'İA
Sheets("SONUC").Cells(i + 2, aa + 9) = ListBox1.Column(9, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 10) = ListBox1.Column(10, i - 1) 'İK
Sheets("SONUC").Cells(i + 2, aa + 11) = ListBox1.Column(11, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 12) = ListBox1.Column(12, i - 1) 'ZA
Sheets("SONUC").Cells(i + 2, aa + 13) = ListBox1.Column(13, i - 1)
Sheets("SONUC").Cells(i + 2, aa + 14) = ListBox1.Column(14, i - 1) 'SAT
Sheets("SONUC").Cells(i + 2, aa + 15) = ListBox1.Column(15, i - 1)

Sheets("SONUC").Cells(i + 2, aa + 18) = ListBox1.Column(18, i - 1) 'SAYIM
Sheets("SONUC").Cells(i + 2, aa + 19) = ListBox1.Column(19, i - 1)
Next

Set s1 = Sheets("SONUC")

'sıralama b1 e göre
s1.[b3].Resize(1000, 22).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("B2").Select ' Sıralanıyor.
s1.[N1].Value = TextBox1.Value  'formdaki tarih bilgisi
s1.[s1].Value = TextBox2.Value   'formdaki tarih bilgisi
'*******************************************
MsgBox "Bitti"
'[a1].Select
Set s1 = Nothing
'Set s2 = Nothing
 
 

End Sub

 

[Korhan Ayhan]

Merhaba,

Kodları hızlandırma ifadelerini kullanmayı deneyin.

Sub TEST()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        
    'Kodlarınız...
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[a_self_lion]

Korhan bey Süpersiniz Teşekkür ederim.