تسريع كود بحث

[محمد الورفلي1]

المقصود من التسريع "هو اذا اردت استدعاء الاسم الموجود في الصف رقم "65532  " يستغرق وقت طويا جدا ً لجلب بيانات هذا الاسم

المطلوب ان كان يوجد كود اسرع من هذا الكود ااو تعديله بارك الله فيكم

Private Sub ComboBox3_Change()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

On Error Resume Next
III = 5
Do Until Sheet2.Cells(III, "c").Text = ""
    If Me.ComboBox3.Text = Sheet2.Cells(III, "c").Text Then
        Cells(III, "c").Activate
Me.TextBox1.Text = ActiveCell.Offset(0, -1).Text
Me.TextBox133.Text = ActiveCell.Offset(0, 0).Text
Me.TextBox132.Text = ActiveCell.Offset(0, 1).Text
Me.TextBox11.Text = ActiveCell.Offset(0, 2).Text
Me.ComboBox2.Text = ActiveCell.Offset(0, 3).Text
Me.TextBox3.Text = ActiveCell.Offset(0, 4).Text
Me.TextBox4.Text = ActiveCell.Offset(0, 5).Text
Me.TextBox7.Text = ActiveCell.Offset(0, 6).Text
Me.TextBox130.Text = ActiveCell.Offset(0, 7).Text
Me.TextBox131.Text = ActiveCell.Offset(0, 8).Text
Me.TextBox22.Text = ActiveCell.Offset(0, -2).Text


e.ComboBox22.Text = ActiveCell.Offset(0, -2).Text
Exit Sub
    End If
    III = III + 1
Loop
MsgBox ("الكود الذى ادخلته غير صحيح")
'Me.TextBox2.SetFocus

Me.TextBox1.Text = ""
'Me.TextBox2.Text = ""
Me.TextBox3.Text = ""
Me.TextBox4.Text = ""
'Me.TextBox5.Text = ""
'Me.TextBox6.Text = ""
Me.TextBox7.Text = ""
'Me.TextBox8.Text = ""
'Me.TextBox9.Text = ""
'Me.TextBox10.Text = ""
Me.TextBox11.Text = ""
'Me.TextBox12.Text = ""
'Me.TextBox13.Text = ""
'Me.TextBox14.Text = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

 

 

Book1669.rar

[سليم حاصبيا]

الملف كبير جداً

لكن هذا الماكرو    يغنيك عن الحلقات التكرارية حتى 65000 واكثر

فقط ادرج الارقام الصحيحة للــ ComboBoxes  في الكود (انا لم أشاهد ComboBoxes رقم 133 مثلاً)

Private Sub ComboBox3_Change()
Dim Laste_row#: Laste_row = Sheets("data").Cells(Rows.Count, 1).End(3).Row
Dim My_rgA As Range, r#
Dim sarch_Rg As Range
Set My_rgA = Range("a5:a" & Laste_row)
Dim my_st
my_st = Me.ComboBox3.Text
Set sarch_Rg = My_rgA.Find(my_st)
If sarch_Rg Is Nothing Then Exit Sub
r = sarch_Rg.Row
  With Cells(r, "c")
   Me.TextBox1.Text = .Offset(0, -1)
   Me.TextBox133.Text = .Offset(0, 0)
   Me.TextBox132.Text = .Offset(0, 1)
   Me.TextBox111.Text = .Offset(0, 2)
   Me.TextBox2.Text = .Offset(0, 3)
   Me.TextBox3.Text = .Offset(0, 4)
   Me.TextBox4.Text = .Offset(0, 5)
   Me.TextBox7.Text = .Offset(0, 6)
   Me.TextBox130.Text = .Offset(0, 7)
   Me.TextBox131.Text = .Offset(0, 8)
    Me.TextBox22.Text = Offset(0, -2)
  
  End With
End Sub

 

[محمد الورفلي1]

السلام عليكم

عند تجربة الماكرو ووضع رقم في شريط البحث لم يستج لاستدعاء البيانات

[سليم حاصبيا]

في هذا الملف نموذج عما تريد (فقط 10 اسماء  للتدقيق في عمل الكود)يمكنك اضافة ما تريد من الصفوف

مع تصحيح للماكرو

 

 

Salim_User.xlsm