Numaralandırma

[acebeci]

Sevgili arkadaşlar aşağıdaki kodlar ile bi raporlama yapıyorum(bu kodları bu forumda ki çok değerli arkadaşlar yazdı). Raporlama sonuçlarını çalışma sayfasına aktarınca A Sütununda numaralandırma yapıyor(1.2.34....... diye) Veriler çok fazla olduğu için bu raporlamayı çok yavaşlatıyor çok uzun sürüyor. O numaralandırma işini iptal edebilir miyiz ? yada başka türlü hızlandırabilir miyiz yardımcı olabilir misiniz? Şimdiden ilginizden dolayı çok teşekkür ederim

Private Sub CommandButton1_Click() 'Sorgula
Dim HaricSayfalar() As Variant, son_tarih As Date
HaricSayfalar = Array("YAZDIR", "CARİ", "RAPOR", "LİSTE", "ŞABLON")
ListBox1.Clear
If IsDate(DTPicker1) = False And DTPicker1 <> "Tümü" Then
MsgBox "İlk Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker1 <> "Tümü" Then Tarih = CDate(DTPicker1)
If IsDate(DTPicker2) = False And DTPicker2 <> "Tümü" Then
MsgBox "Son Tarih girişinde bir hata var. Lütfen kontrol edip, düzeltiniz", vbCritical, "UYARI"
Exit Sub
End If
If DTPicker2 <> "Tümü" Then son_tarih = CDate(DTPicker2)
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 2).End(xlUp).Row
If DTPicker1.Value = "Tümü" Or DTPicker2.Value = "Tümü" Or sh.Cells(i, 2) >= Tarih _
And sh.Cells(i, 2) <= son_tarih Then
If sh.Cells(i, 3) = ComboBox2 Or ComboBox2 = "Tümü" Then
If sh.Cells(i, 4) = ComboBox3 Or ComboBox3 = "Tümü" Then
If sh.Cells(i, 5) = ComboBox4 Or ComboBox4 = "Tümü" Then
If sh.Cells(i, 9) = ComboBox6 Or ComboBox6 = "Tümü" Then
If sh.Cells(i, 17) = ComboBox7 Or ComboBox7 = "Tümü" Then
If sh.Cells(i, 18) = ComboBox8 Or ComboBox8 = "Tümü" Then
With ListBox1
.AddItem Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 1 To 22
.List(ListBox1.ListCount - 1, j) = sh.Cells(i, j + 2)

Next j
' .List(ListBox1.ListCount - 1, 1) = sh.Cells(i, 1)
' .List(ListBox1.ListCount - 1, 2) = sh.Cells(i, 2)
' .List(ListBox1.ListCount - 1, 3) = sh.Cells(i, 3)
End With
End If
End If
End If
End If
End If
End If
End If
Next i
End If
x = 0
Next
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
sirala
With Sheets("Rapor")
.Cells(2, 1) = "SORGU -> Tarih:" & ComboBox1 _
& ", Tarla Sahibi:" & ComboBox2 _
& ", Kime Gittiği:" & ComboBox3 _
& ", Plaka:" & ComboBox4 _
& ", Cinsi:" & ComboBox6 _
& ", Yükleme:" & ComboBox7 _
& ", İşcilik:" & ComboBox8


.Range("A4:AT10000").ClearContents
.Cells(4, 2).Resize(ListBox1.ListCount, 42) = ListBox1.List
For i = 4 To .Cells(65536, 2).End(xlUp).Row
y = y + 1
.Cells(i, 1) = y
Next i
End With
End Sub


Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then Unload Me
End Sub



Private Sub UserForm_Initialize()
Dim HaricSayfalar() As Variant
Dim sh As Object
Dim arrTarlaS() As Variant, arrKime() As Variant, arrPlaka() As Variant, arrCnisi() As Variant, arryükleme() As Variant, arrişcilik() As Variant
Dim arrVeri() As Variant
Dim colTarlaS As New Collection, colKime As New Collection, colPlaka As New Collection, colCinsi As New Collection, colyükleme As New Collection, colişcilik As New Collection
Dim Toplam As Long, y As Long

HaricSayfalar = Array("YAZDIR", "CARİ", "RAPOR", "LİSTE", "ŞABLON")
For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then: Toplam = Toplam + (sh.Cells(65536, 2).End(xlUp).Row - 3)
x = 0
Next

ReDim arrTarlaS(Toplam)
ReDim arrKime(Toplam)
ReDim arrPlaka(Toplam)
ReDim arrCinsi(Toplam)
ReDim arryükleme(Toplam)
ReDim arrişcilik(Toplam)

For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 5 To sh.Cells(65536, 2).End(xlUp).Row
arrTarlaS = sh.Cells(i, 3).Value
arrKime = sh.Cells(i, 4).Value
arrPlaka = sh.Cells(i, 5).Value
arrCinsi = sh.Cells(i, 9).Value
arryükleme = sh.Cells(i, 17).Value
arrişcilik = sh.Cells(i, 18).Value

y = y + 1
Next i
End If
x = 0
Next
On Error Resume Next
colTarlaS.Add "Tümü", "Tümü": colTarlaS.Add arrTarlaS(0), arrTarlaS(0)
colKime.Add "Tümü", "Tümü": colKime.Add arrKime(0), arrKime(0)
colPlaka.Add "Tümü", "Tümü": colPlaka.Add arrPlaka(0), arrPlaka(0)
colCinsi.Add "Tümü", "Tümü": colCinsi.Add arrCinsi(0), arrCinsi(0)
colyükleme.Add "Tümü", "Tümü": colyükleme.Add arryükleme(0), arryükleme(0)
colişcilik.Add "Tümü", "Tümü": colişcilik.Add arrişcilik(0), arrişcilik(0)


For i = 0 To UBound(arrTarlaS) - 1

For Each Eleman1 In colTarlaS
If Eleman1 = arrTarlaS(i) Then: x = x + 1
Next
If x = 0 Then colTarlaS.Add arrTarlaS(i), arrTarlaS(i)
x = 0

For Each Eleman2 In colKime
If Eleman2 = arrKime(i) Then: y = y + 1
Next
If y = 0 Then colKime.Add arrKime(i), arrKime(i)
y = 0

For Each Eleman3 In colPlaka
If Eleman3 = arrPlaka(i) Then: Z = Z + 1
Next
If Z = 0 Then colPlaka.Add arrPlaka(i), arrPlaka(i)
Z = 0
For Each Eleman4 In colCinsi
If Eleman4 = arrCinsi(i) Then: w = w + 1
Next
If w = 0 Then colCinsi.Add arrCinsi(i), arrCinsi(i)
w = 0
For Each Eleman5 In colyükleme
If Eleman5 = arryükleme(i) Then: c = c + 1
Next
If c = 0 Then colyükleme.Add arryükleme(i), arryükleme(i)
c = 0
For Each Eleman6 In colişcilik
If Eleman6 = arrişcilik(i) Then: g = g + 1
Next
If g = 0 Then colişcilik.Add arrişcilik(i), arrişcilik(i)
g = 0

Next
ComboBox1.AddItem "Tümü": ComboBox1.ListIndex = 0
For Each Eleman In colTarlaS: ComboBox2.AddItem Eleman: Next: ComboBox2.ListIndex = 0
For Each Eleman In colKime: ComboBox3.AddItem Eleman: Next: ComboBox3.ListIndex = 0
For Each Eleman In colPlaka: ComboBox4.AddItem Eleman: Next: ComboBox4.ListIndex = 0
For Each Eleman In colCinsi: ComboBox6.AddItem Eleman: Next: ComboBox6.ListIndex = 0
For Each Eleman In colyükleme: ComboBox7.AddItem Eleman: Next: ComboBox7.ListIndex = 0
For Each Eleman In colişcilik: ComboBox8.AddItem Eleman: Next: ComboBox8.ListIndex = 0
With ListBox1
.Clear
.ColumnCount = 4
.ColumnWidths = "100;135;112;100"
End With

ReDim arrVeri(1 To Toplam, 1 To 23)

For Each sh In ThisWorkbook.Sheets
For i = 0 To UBound(HaricSayfalar) - 1
If HaricSayfalar(i) = sh.Name Then x = x + 1
Next i
If x = 0 Then
For i = 4 To sh.Cells(65536, 2).End(xlUp).Row
a = a + 1
arrVeri(a, 1) = Format(sh.Cells(i, 2), "dd.mm.yyyy")
For j = 2 To 22
arrVeri(a, j) = sh.Cells(i, j + 1)
Next j
Next i
End If
x = 0
Next
DTPicker1.Value = Date
DTPicker2.Value = Date
ListBox1.List = arrVeri
CommandButton2.Cancel = True
ComboBox5.AddItem "Tümü"
ComboBox5.ListIndex = 0
ComboBox6.AddItem "Tümü"
ComboBox6.ListIndex = 0
ComboBox7.AddItem "Tümü"
ComboBox7.ListIndex = 0
ComboBox8.AddItem "Tümü"
ComboBox8.ListIndex = 0
End Sub