Aşağıdaki kod 2 sene önce başka bir excel sitesindeki arkadaşların yardımı ile hazırlanmıştı, o zamanki kayıtlarımız 2000 tane kadar olduğundan tüm kayıtların yüklenmesi sorun olmuyordu, ama şu andaki kayıt adedi 6000 i geçtiği için listbox a yüklenmesi uzun sürüyor, ayrıca listbox ta o kadar eski kayıtların da olması gereksiz bunu sadece son 100 veya 200 kayıdı okur hale getirmem için nasıl bir değişiklik gerekli ?
yardımcı olursanız sevinirim.
Private Sub CommandButton12_Click()
Application.ScreenUpdating = False
Windows("database.xls").Activate
Sheets("database").Select
Dim say As Integer
Dim myArray3()
say = WorksheetFunction.CountA(Range("a1:a65536"))
ReDim myArray3(say, 9)
Dim y, i As Integer
y = 0
With ListBox1
.ColumnCount = 10
.ColumnWidths = "0;50;50;0;0;0;90;100;150;70"
End With
For y = 1 To WorksheetFunction.CountA(Range("a1:a65536"))
myArray3(y - 1, 0) = ""
myArray3(y - 1, 1) = ""
myArray3(y - 1, 2) = ""
myArray3(y - 1, 3) = ""
myArray3(y - 1, 4) = ""
myArray3(y - 1, 5) = ""
myArray3(y - 1, 6) = ""
myArray3(y - 1, 7) = ""
myArray3(y - 1, 8) = ""
myArray3(y - 1, 9) = ""
Next y
y = 1
For i = say + 1 To 2 Step -1
y = y + 1
myArray3(0, 0) = Cells(1, 1).Value
myArray3(0, 2) = Cells(1, 3).Value
myArray3(0, 3) = Cells(1, 4).Value
myArray3(0, 4) = Cells(1, 5).Value
myArray3(0, 5) = Cells(1, 6).Value
myArray3(0, 6) = Cells(1, 7).Value
myArray3(0, 7) = Cells(1, 8).Value
myArray3(0, 8) = Cells(1, 9).Value
myArray3(0, 9) = Cells(1, 25).Value
myArray3(y - 1, 0) = Cells(i, 1).Value
myArray3(y - 1, 1) = Cells(i, 2).Value
myArray3(y - 1, 2) = Cells(i, 3).Value
myArray3(y - 1, 3) = Cells(i, 4).Value
myArray3(y - 1, 4) = Cells(i, 5).Value
myArray3(y - 1, 5) = Cells(i, 6).Value
myArray3(y - 1, 6) = Cells(i, 7).Value
myArray3(y - 1, 7) = Cells(i, 8).Value
myArray3(y - 1, 8) = Cells(i, 9).Value
myArray3(y - 1, 9) = Cells(i, 25).Value
Next i
kayit_formu.ListBox1.List() = myArray3
End Sub
yardımcı olursanız sevinirim.
Private Sub CommandButton12_Click()
Application.ScreenUpdating = False
Windows("database.xls").Activate
Sheets("database").Select
Dim say As Integer
Dim myArray3()
say = WorksheetFunction.CountA(Range("a1:a65536"))
ReDim myArray3(say, 9)
Dim y, i As Integer
y = 0
With ListBox1
.ColumnCount = 10
.ColumnWidths = "0;50;50;0;0;0;90;100;150;70"
End With
For y = 1 To WorksheetFunction.CountA(Range("a1:a65536"))
myArray3(y - 1, 0) = ""
myArray3(y - 1, 1) = ""
myArray3(y - 1, 2) = ""
myArray3(y - 1, 3) = ""
myArray3(y - 1, 4) = ""
myArray3(y - 1, 5) = ""
myArray3(y - 1, 6) = ""
myArray3(y - 1, 7) = ""
myArray3(y - 1, 8) = ""
myArray3(y - 1, 9) = ""
Next y
y = 1
For i = say + 1 To 2 Step -1
y = y + 1
myArray3(0, 0) = Cells(1, 1).Value
myArray3(0, 2) = Cells(1, 3).Value
myArray3(0, 3) = Cells(1, 4).Value
myArray3(0, 4) = Cells(1, 5).Value
myArray3(0, 5) = Cells(1, 6).Value
myArray3(0, 6) = Cells(1, 7).Value
myArray3(0, 7) = Cells(1, 8).Value
myArray3(0, 8) = Cells(1, 9).Value
myArray3(0, 9) = Cells(1, 25).Value
myArray3(y - 1, 0) = Cells(i, 1).Value
myArray3(y - 1, 1) = Cells(i, 2).Value
myArray3(y - 1, 2) = Cells(i, 3).Value
myArray3(y - 1, 3) = Cells(i, 4).Value
myArray3(y - 1, 4) = Cells(i, 5).Value
myArray3(y - 1, 5) = Cells(i, 6).Value
myArray3(y - 1, 6) = Cells(i, 7).Value
myArray3(y - 1, 7) = Cells(i, 8).Value
myArray3(y - 1, 8) = Cells(i, 9).Value
myArray3(y - 1, 9) = Cells(i, 25).Value
Next i
kayit_formu.ListBox1.List() = myArray3
End Sub