مشكلتين فى الليست بوكس

[أبو چيداء]

المشكلة الاولى اذا كانت النتيجة فى الليست بوكس فى صف واحد وليست اكثر من صف تأتر النتيجة تحت بعضها وليست فى صف واحد(فى المرفقات)

المشكلة الثانية ولكنها ليست فى هذا الشيت والكود فى الاسفل والمشكلة انها لوالليست بكوس الاولى بها اربعة سطور تاتى النتيجة فى الليست بوكس الثانية النتيجة مسبوقة باربعة سطور خاليين فما الحل

Private Sub TextBox1_Change()
Set ws1 = Sheets("sheet1")
Set ws2 = Sheets("sheet2")
Set ws3 = Sheets("sheet3")
Dim arr()
Dim arr2()
Me.TextBox2 = ""
Me.TextBox4 = ""
Me.TextBox5 = ""
Me.TextBox7 = ""
Me.TextBox8 = ""
Me.TextBox9 = ""
Me.TextBox10 = ""
Me.TextBox13 = ""
Me.TextBox14 = ""
Me.TextBox15 = ""
ListBox1.Clear
ListBox2.Clear
LR = ws1.Cells(Rows.Count, 1).End(xlUp).Row
LR2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
LR3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row
Set Rng1 = ws1.Range("A2:A" & LR)
Set Rng2 = ws2.Range("A2:A" & LR2)
Set Rng3 = ws3.Range("A2:A" & LR3)

X = Val(Me.TextBox1)
'=======================================
On Error Resume Next
For Each cl In Rng1
    If cl = X Then
        Me.TextBox2 = cl.Offset(0, 1)
        Me.TextBox4 = cl.Offset(0, 3)
        Me.TextBox5 = cl.Offset(0, 2)
        Me.TextBox7 = cl.Offset(0, 4)
        Me.TextBox8 = cl.Offset(0, 5)
        Me.TextBox9 = cl.Offset(0, 6)
        Me.TextBox10 = Format(cl.Offset(0, 8), "# ")
        Exit For
    End If
Next
For Each clll In Rng3
    If clll = X Then
        i = i + 1
        ReDim Preserve arr(1 To 2, 1 To i)
        arr(1, i) = clll.Offset(0, 19)
        arr(2, i) = clll.Offset(0, 23)
    End If
Next
R = UBound(arr, 1): RR = UBound(arr, 2)

Me.ListBox2.List = Application.WorksheetFunction.Transpose(arr)
    
For Each cll In Rng2
    If cll = X Then
        i = i + 1
        ReDim Preserve arr2(1 To 5, 1 To i)
        arr2(1, i) = cll.Offset(0, 2)
        arr2(2, i) = Format(cll.Offset(0, 3), "yyyy/mm/dd")
        arr2(3, i) = Format(cll.Offset(0, 4), "yyyy/m/dd")
        arr2(4, i) = cll.Offset(0, 5)
        arr2(5, i) = Format(cll.Offset(0, 6), "0%")
    End If
Next
R = UBound(arr2, 1): RR = UBound(arr2, 2)

Me.ListBox1.List = Application.WorksheetFunction.Transpose(arr2)

Set sh2 = Sheets("Appraisal")
LR4 = sh2.[A10000].End(xlUp).Row
For Each cl In sh2.Range("A2:A" & LR4)
If Val(Me.TextBox1) = cl Then
Me.TextBox13 = cl.Offset(0, 35)
Me.TextBox14 = cl.Offset(0, 36)
Me.TextBox15 = cl.Offset(0, 37)
End If
Next
End Sub

هام جدا3.zip