قاعدة بيانات كبيرة والفورم المرفق يعمل ببطئ .. فما هو الحل ؟

[sarab1618]

الفورم المرفق يعمل علي البحث عن قيمة محددة واظهار كافة المعلومات المرتبطة بهذه القيمة والنية لدي على تطوير هذا الفورم شيئاً فشيئا لكن واجهتني مشكلة البطئ في إظهار النتائج بسبب كبر قاعدة البيانات فقد تصل إلى ( 50000 ) صف فما هو العمل لجعل الفورم يعمل بسرعة أكبر ... وشكرا على الردود والمرور مسبقاً ...

 

 

2222.rar

[احمد عبد الناصر]

السلام عليكم

 

استاذ سراب ,

 

جرب بدل الاكواد السابقة بهذه الاكواد .

 

ملاحظة : ما زال بطيء نسبيا عند البحث (اعتقد لو استخدم find سيصبح اسرع من loop ) و لكنه اصبح سريع جدا عند الاختيار من الليست بوكس بعد البحث .

Private Sub CommandButton20_Click()

If TextBox35.Text <> "" Then
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "100;0"
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
For T = 3 To lastrow
If InStr(Sheet1.Cells(T, 3).Text, TextBox35.Text) > 0 Then
ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = Sheet1.Cells(T, 3)
ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(T, 3).Row
End If
Next
End If

End Sub

Private Sub ListBox1_Change()

i = ListBox1.List(ListBox1.ListIndex, 1)
For R = 1 To 10
Me.Controls("TextBox" & R).Value = Sheet1.Cells(i, R).Value
Next

End Sub
 

تحياتي

[sarab1618]

ألف شكر أستاذ أحمد وبجد مجهودك أكثر من رائع ....

لكن قمت بتبديل الأكواد على قاعدة البيانات الأساسية - وهي أكبر من الفورم بكثير - وعملية البحث كانت تستغرق دقيقة أما بعد فكرتك الاخيرة أصبحت الفترة حوالي عشرون ثانية وهذا جيد ... وبالمناسبة ماذا تعني بعبارة ( اعتقد لو استخدم find سيصبح اسرع من loop )

أرجو ألا أكون مملا أو لحوحا لكن الفورم يأخذ كل تفكيري ...

[sarab1618]

وقد لاحظت بأن الأمر ( تفريغ ) يعطي رسالة خطا بسبب مشكلة في كود الليست بوكس ...

[احمد عبد الناصر]

السلام عليكم

 

اخي الكريم , جرب بدل الاكواد السابقة بهذه الاكواد و اخبرني بالنتيجة .

Private Sub CommandButton20_Click()
ListBox1.Clear
If TextBox35.Text <> "" Then
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "100;0"
If Application.WorksheetFunction.CountIf(Range("C2:c" & Range("c" & Rows.Count).End(xlUp).Row), "*" & TextBox35.Text & "*") > 0 Then
Application.ScreenUpdating = False
Dim arr()
Range("C2:c" & Range("c" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, Criteria1:="=*" & TextBox35.Text & "*"
ReDim arr(1 To 2, 1 To Range("C2:c" & Range("c" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count)
For Each c In Range("C3:c" & Range("c" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
arr(1, x + 1) = c.Value
arr(2, x + 1) = c.Row
x = x + 1
Next
[a1].AutoFilter
Application.ScreenUpdating = True
ListBox1.Column = arr
End If
End If
End Sub

Private Sub CommandButton21_Click()
ListBox1.Clear
If TextBox33.Text <> "" Then
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "100;0"
If Application.WorksheetFunction.CountIf(Range("C2:c" & Range("c" & Rows.Count).End(xlUp).Row), TextBox33.Text & "*") > 0 Then
Application.ScreenUpdating = False
Dim arr()
Range("C2:c" & Range("c" & Rows.Count).End(xlUp).Row).AutoFilter Field:=1, Criteria1:="=" & TextBox33.Text & "*"
ReDim arr(1 To 2, 1 To Range("C2:c" & Range("c" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count)
For Each c In Range("C3:c" & Range("c" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
arr(1, x + 1) = c.Value
arr(2, x + 1) = c.Row
x = x + 1
Next
[a1].AutoFilter
Application.ScreenUpdating = True
ListBox1.Column = arr
End If
End If
End Sub

Private Sub ListBox1_Click()
i = ListBox1.List(ListBox1.ListIndex, 1)
For R = 1 To 10
Me.Controls("TextBox" & R).Value = Sheet1.Cells(i, R).Value
Next
End Sub

Private Sub CommandButton19_Click()
i = ListBox1.List(ListBox1.ListIndex, 1)
Cells(i, 1).Select
sama = MsgBox("åá ÊÑíÏ ÇáÐåÇÈ ááÇÓã ÇáãÍÏÏ ÇáÐí ÞãÊ ÈÇÎÊíÇÑå", vbYesNo, "ÑÓÇáÉ ÊÃßíÏ")
If sama = vbYes Then
UserForm1.Hide
Else
Exit Sub
End If
End Sub

تحياتي

[sarab1618]

صدقا أخ أحمد .. أنا كتير ممنون ... وجزاك الله عنا كل خير .... الفورم يعمل بشكل رائع الآن ... وسأتابع العمل على تطويره ... وإذا وقعت بمشكلة ثانية مالنا غير أستاذنا أحمد

[احمد عبد الناصر]

 

الفورم يعمل بشكل رائع الآن

 

 

حمدا لله 

 

و لا تتردد في اي استفسار مستقبلا 

 

حاول متابعة سلسلة استاذ حمادة عمر (سلسلة خطوة ب خطوة )  ستوفر عليك الكثير مسقبلا في فهم الاكواد .

 

تقبل خالص تحياتي