listbox sadece son dönem kayıtların getirilmesi

[hayalbert]

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

 

[veyselemre]

[vb:1:90b0e2f406]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"))
If say < 100 Then say = 101

ReDim myArray3(0 To 100, 0 To 9)

Dim y, i As Integer

With ListBox1
.ColumnCount = 10
.ColumnWidths = "0;50;50;0;0;0;90;100;150;70"
End With

For c = 0 To 8
myArray3(0, c) = Cells(1, c + 1).Value
Next c
myArray3(0, 9) = Cells(1, 25).Value

y = 1

For i = say To say - 99 Step -1
For c = 0 To 8
myArray3(y, c) = Cells(i, c + 1).Value
Next c
myArray3(y, 9) = Cells(i, 25).Value
y = y + 1
Next i

kayit_formu.ListBox1.List() = myArray3

End Sub
[/vb:1:90b0e2f406]

 

[hayalbert]

teşekkür ederim k:: :dua2:

 

[hayalbert]

peki bu adedi bir textbox ta belirli rakama bağlıyabilir miyim ?
bir kaç şey denedim olmadı da
say - 99 dışında hiç bir şey çalışmadı
:kafa:

 

[hayalbert]

redim varsayılanını da düzeltince halloldu

aşağıdaki gibi

Private Sub CommandButton12_Click()

Application.ScreenUpdating = False
Windows("database.xls").Activate
Sheets("database").Select
Dim say, y, i, c, adet As Integer
Dim myArray3()
say = WorksheetFunction.CountA(Range("a1:a65536"))
adet = say - TextBox7.Value

If say < 100 Then say = 101

ReDim myArray3(0 To TextBox7.Value, 0 To 9)

With ListBox1
.ColumnCount = 10
.ColumnWidths = "0;50;50;0;0;0;90;100;150;70"
End With

For c = 0 To 8
myArray3(0, c) = Cells(1, c + 1).Value
Next c
myArray3(0, 9) = Cells(1, 25).Value

y = 1

For i = say To say - TextBox7.Value + 1 Step -1
For c = 0 To 8
myArray3(y, c) = Cells(i, c + 1).Value
Next c
myArray3(y, 9) = Cells(i, 25).Value
y = y + 1
Next i

kayit_formu.ListBox1.List() = myArray3
Label56.Caption = "toplam " & WorksheetFunction.CountA(Range("a1:a65536")) & " adet kayıt var"

End Sub