ابو عبدالرحمن البغدادي قام بنشر أكتوبر 23, 2015 مشاركة قام بنشر أكتوبر 23, 2015 (معدل) السلام عليكم - حياكم الله اخواني واساتذي في منتدى اوفيسنا توجد عندي مشكلة وهي : بطأ عند استدعاء البيانات عند اجراء بحث (شيت البحث) ، فعند ادخل البيانات وعددها (35000) موظف في شيت وزارة1 فقط ، وعند اجراء البحث عن الموظف انتظر طويلاً حتى تأتي البيانات مما سبب لي التأخير في العمل ممكن وفقكم الله اجراء تعديل على الكود حتى تأتينا البيانات بشكل اسرع ، ولقد حذفت البيانات بسبب تظهر لي رسالة لا يمكن تحميل الملف الحد المسموح وزارات المحافظة_ بطأ استدعاء البيانات عند اجراء البحث في شيت البحث.rar تم تعديل أكتوبر 23, 2015 بواسطه ابو عبدالرحمن البغدادي رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 23, 2015 مشاركة قام بنشر أكتوبر 23, 2015 أخي الكريم أبو عبد الرحمن البغدادي بالنسبة للملف المرفق في ورقة البحث يرجى إعادة تنظيم الورقة بحيث يسهل الوصول لحل إن شاء المولى عندي لك حل ، ولكن يرجى إرفاق الملف مرة أخرى مع ضبط ورقة البحث بالشكل الملائم حيث لاحظت أن البيانات في العمود الأول تبدأ من الصف رقم 2 وتنتهي في الصف 26 بينما في العمود الثالث تبدأ من الصف رقم 3 وتنتهي في الصف رقم 27 كما أن البيان الخاص برقم الوزارة مكرر في العمود الأول لابد من أن يكون الملف منظم حتى يخرج العمل بشكل جيد وتكون النتائج صخيحة .. تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
ابو عبدالرحمن البغدادي قام بنشر أكتوبر 23, 2015 الكاتب مشاركة قام بنشر أكتوبر 23, 2015 السلام عليكم - حياكم الله اخي ارفق ملف ، وارجو أن ألقى اجابة لموضوع لأهميته وعملي متوقف حاليا حتى يتم حل مشكلة بطأ استدعاء المعلومات ، وكذلك اترك لك أي فكرة ترونها مناسبة لحل البطأ وتؤدي الى النتيجة نفسها ، اذا إن هذا البطأ قد عرقل عملي وزارات المحافظة_ بطأ استدعاء البيانات عند اجراء البحث في شيت البحث111.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 23, 2015 مشاركة قام بنشر أكتوبر 23, 2015 أخي الكريم جرب الملف المرفق التالي ** الكود مقسم إلى كود يوضع في موديول عادي Public Arr, ArrOut Sub RefreshArray() Dim WS As Worksheet, ArrTemp, I As Long, P As Long ReDim Arr(1, 0) For Each WS In Sheets If WS.Name <> "البحث" And WS.Name <> "تصفية البيانات المكررة " And WS.Name <> "بيانات ثانوية" Then If WS.Cells(Rows.Count, "G").End(xlUp).Row > 1 Then ArrTemp = WS.Range("A1").CurrentRegion.Columns("G").Value I = UBound(Arr, 2) + UBound(ArrTemp, 1) ReDim Preserve Arr(1, I) For I = 2 To UBound(ArrTemp, 1) If Len(ArrTemp(I, 1)) Then Arr(0, P) = ArrTemp(I, 1) Arr(1, P) = WS.Name & "/" & I P = P + 1 End If Next I End If End If Next WS ReDim Preserve Arr(1, P - 1) End Sub Sub GetSearchResult(Param As String) Dim LastRow As Long, I As Long, P As Long If Not IsArray(Arr) Then RefreshArray ReDim ArrOut(1, UBound(Arr, 2)) With Sheets("البحث") LastRow = Application.Max(.Cells(.Rows.Count, "E").End(xlUp).Row, 3) .Range("E3:E" & LastRow).ClearContents P = 0 For I = LBound(Arr, 2) To UBound(Arr, 2) If InStr(1, Arr(0, I), Param, vbTextCompare) Then ArrOut(0, P) = Arr(0, I) ArrOut(1, P) = Arr(1, I) P = P + 1 End If Next I If P > 0 And Param <> "" Then ReDim Preserve ArrOut(1, P - 1) .Range("E3").Resize(UBound(ArrOut, 2) + 1, 1).Value = Application.Transpose(ArrOut) Else .Range("B2:B26,D2:D26").ClearContents End If End With End Sub Sub RefreshList(Param As Long) Dim Arr, ArrOut1(1 To 25, 1 To 1), ArrOut2(1 To 25, 1 To 1), I As Long With Sheets("البحث") .Range("B2:B26,D2:D26").ClearContents On Error Resume Next Arr = Sheets(Split(ArrOut(1, Param - 3), "/")(0)).Rows(Val(Split(ArrOut(1, Param - 3), "/")(1))).Resize(, 56).Value If Err.Number <> 0 Then Exit Sub On Error GoTo 0 ArrOut1(1, 1) = Arr(1, 9) For I = 2 To 25 ArrOut1(I, 1) = Arr(1, I + 5) Next I For I = 1 To 25 ArrOut2(I, 1) = Arr(1, I + 31) Next I .Range("B2").Resize(UBound(ArrOut1, 1), UBound(ArrOut1, 2)).Value = ArrOut1 .Range("D2").Resize(UBound(ArrOut2, 1), UBound(ArrOut2, 2)).Value = ArrOut2 End With End Sub والجزء الثاني يوضع في حدث ورقة العمل المسماة "البحث" Private Sub TextBox1_Change() GetSearchResult TextBox1.Text End Sub Private Sub Worksheet_Activate() RefreshArray End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Columns("E")) Is Nothing Then If Target.Row >= 3 And Target.Count = 1 Then If Len(Target.Value) Then RefreshList Target.Row End If End If End Sub أرجو أن يكون المطلوب ويعالج مشكلة البطء لديك إن شاء الله تقبل تحياتي Textbox Search All Sheets YasserKhalil.rar 3 رابط هذا التعليق شارك More sharing options...
ابو عبدالرحمن البغدادي قام بنشر أكتوبر 23, 2015 الكاتب مشاركة قام بنشر أكتوبر 23, 2015 (معدل) السلام عليكم اقول : جزيت خيرا - جزيت خيرا - جزيت خير اقول : رزقك الله حظ الدنيا والاخرة اقول : تمام تمام تمام 100 % انتهى البطأ اشكرك تم تعديل أكتوبر 23, 2015 بواسطه ابو عبدالرحمن البغدادي 2 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 23, 2015 مشاركة قام بنشر أكتوبر 23, 2015 وعليكم السلام أخي الكريم أبو عبد الرحمن الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات جزيت خيراً بمثل ما دعوت لي تقبل تحياتي رابط هذا التعليق شارك More sharing options...
ابو عبدالرحمن البغدادي قام بنشر أكتوبر 23, 2015 الكاتب مشاركة قام بنشر أكتوبر 23, 2015 وعليكم السلام أخي الكريم أبو عبد الرحمن الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات جزيت خيراً بمثل ما دعوت لي تقبل تحياتي ادخلت بحدود 90000 موظف وما شاء الله سريع الحمد لله 1 رابط هذا التعليق شارك More sharing options...
ياسر العربى قام بنشر أكتوبر 24, 2015 مشاركة قام بنشر أكتوبر 24, 2015 يا سلام تسلم ابو البراء على المجهود الرائع المبذول منك لخدمة اعضاء المنتدى جزيت خيرا عنا وعن جميع المستفيدين رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 24, 2015 مشاركة قام بنشر أكتوبر 24, 2015 أخي الغالي ياسر العربي مشكور على مرورك العطر وكلماتك الرقيقة الطيبة ، وجزيت خيراً بمثل ما دعوت وإن شاء الله نستفيد جميعاً من خبرتك الواسعة (يا ما في الجراب يا عربي) 1 رابط هذا التعليق شارك More sharing options...
محمد صبحى عبدالنعيم قام بنشر ديسمبر 25, 2015 مشاركة قام بنشر ديسمبر 25, 2015 سلمت يمينك ا ياسر رابط هذا التعليق شارك More sharing options...
مختار البركاني قام بنشر ديسمبر 26, 2015 مشاركة قام بنشر ديسمبر 26, 2015 بارك الله فيك استاذ ياسر خليل وجزاك خير الجزاء رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان