Çözüldü Aranan Veri Bulunamayınca Debug Hatası Sorunu

[ozbinici07]

Aşağıdaki Kod İle Veri Arama Yaparken Veri Bulunamayınca Debug Hatası Veriyor Bana Yardımcı Olabilecek Varmı ?

Kod'da Hata Veren Kısım Olarak
ReDim Preserve myarr(1 To 10, 1 To a)
Olarak Gözükmekte

Private Sub CommandButton1_Click()
If OptionButton1.Value = True Then Call bul_59(TextBox2)
End Sub
Private Sub bul_59(ByVal txt As Control)
Dim sut As String, k As Range, adr As String, myarr(), a As Long
Dim sat As Long, deg
ListBox1.Clear
If txt.Text = "" Then Exit Sub
If txt.Name = "TextBox2" Then
    sut = "D"
    deg = txt.Text
   End If

ReDim myarr(1 To 10, 1 To 65536)

'On Error Resume Next

For i = 1 To ActiveWorkbook.Sheets.Count
sayfa = Sheets(i).Name

sat = Sheets(sayfa).Cells(65536, sut).End(xlUp).Row
If Sheets(i).Name <> "Gelen" Then
sat = Sheets(sayfa).Cells(65536, sut).End(xlUp).Row
If Sheets(i).Name <> "Giden" Then
sat = Sheets(sayfa).Cells(65536, sut).End(xlUp).Row
If Sheets(i).Name <> "ilceici" Then
sat = Sheets(sayfa).Cells(65536, sut).End(xlUp).Row
If Sheets(i).Name <> "izin" Then
sat = Sheets(sayfa).Cells(65536, sut).End(xlUp).Row
If Sheets(i).Name <> "Sendika" Then
sat = Sheets(sayfa).Cells(65536, sut).End(xlUp).Row
If Sheets(i).Name <> "USERS" Then

Set k = Sheets(sayfa).Range(sut & "2:" & sut & sat). _
Find(deg & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do

        a = a + 1
        myarr(1, a) = Sheets(sayfa).Cells(k.Row, "B").Value
        myarr(2, a) = Sheets(sayfa).Cells(k.Row, "C").Value
        myarr(3, a) = Sheets(sayfa).Cells(k.Row, "D").Value
        myarr(4, a) = Sheets(sayfa).Cells(k.Row, "E").Value
        myarr(5, a) = Sheets(sayfa).Cells(k.Row, "F").Value
        myarr(6, a) = Sheets(sayfa).Cells(k.Row, "G").Value
        myarr(7, a) = Sheets(sayfa).Cells(k.Row, "H").Value
        myarr(8, a) = Sheets(sayfa).Cells(k.Row, "I").Value
        myarr(9, a) = Sheets(sayfa).Cells(k.Row, "J").Value
        myarr(10, a) = Sheets(sayfa).Cells(k.Row, "K").Value
        Set k = Sheets(sayfa).Range(sut & "2:" & sut & sat).FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr

End If
End If
End If
End If
End If
End If
End If
Next
  ReDim Preserve myarr(1 To 10, 1 To a)
ListBox1.Column = myarr

End Sub
Private Sub ListBox1_Click()
If ListBox1.ColumnCount = 0 Then Exit Sub
TextBox1.Text = ListBox1.Column(0)
TextBox3.Text = ListBox1.Column(1)
TextBox4.Text = ListBox1.Column(2)
TextBox5.Text = ListBox1.Column(3)
TextBox6.Text = ListBox1.Column(4)
TextBox7.Text = ListBox1.Column(5)
TextBox8.Text = ListBox1.Column(6)
TextBox9.Text = ListBox1.Column(7)
End Sub
Private Sub TextBox2_Change()
TextBox2 = Evaluate("=upper(""" & TextBox2 & """)")
End Sub
Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 10
ListBox1.ColumnWidths = "80;150;80;80;60;60;60;60;60;60"
OptionButton1.Value = True
TextBox2.SetFocus
End Sub


Private Sub Image17_Click()
Application.Visible = False
Unload Me
AramaPaneli.Show
End Sub
Private Sub çıkış_Click()
Application.DisplayAlerts = False
MsgBox " Personel Arama İşleminden Çıkılıyor"
ThisWorkbook.Save
Application.DisplayAlerts = True
Application.Quit
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodları

ReDim Preserve myarr(1 To 10, 1 To a)
ListBox1.Column = myarr

Aşağıdakiler ile değiştirip deneyin.

If a > 0 Then
    ReDim Preserve myarr(1 To 10, 1 To a)
    ListBox1.Column = myarr
End If

 

[ozbinici07]

Çok Teşekkür Ederim 2 Gündür Bununla Uğraşıyordum.

Merhaba.
Aşağıdaki kodları

ReDim Preserve myarr(1 To 10, 1 To a)
ListBox1.Column = myarr

Aşağıdakiler ile değiştirip deneyin.

If a > 0 Then
    ReDim Preserve myarr(1 To 10, 1 To a)
    ListBox1.Column = myarr
End If

 

[Muzaffer Ali]

Rica ederim iyi çalışmalar.