abed14092017 قام بنشر مايو 11 مشاركة قام بنشر مايو 11 مرحبا اخواني تحية طيبة ارجو ان تكون بخير و صحة ارفقت ملف اكسل بدخل الملف userform يحتوي على listbox و زر امر , textbox بحيث ابحث عن قيمة في textbox من مجموع من الصفحات , و تظهر النتائج في listbox لكن النتائج تضهر فقط 10 اعمدة وانا احاول ان اضيف عمود باسم الصفحة و عمود بموقع ( رقم الخلية) المطلوب : الكود يضهر 10 اعمدة فقط , ويرفض ان يضهر 12 عمود داخل listbox راجياً مساعدتكم و خبراتكم و تحياتي للجميع اخوكم عبدالله جديد.xlsm رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر مايو 12 مشاركة قام بنشر مايو 12 وعليكم السلام ورحمة الله تعالى وبركاته 1) هل البحث سيكون في عمود معين او في كل الاعمدة من A الى J 2) نطاق البيانات لديك على الملف يبدأ من الخلية a2 والكود يتضمن (a12:j"& lastrow100") !!!! رابط هذا التعليق شارك More sharing options...
abed14092017 قام بنشر مايو 12 الكاتب مشاركة قام بنشر مايو 12 مرحبا اخ محمد هشام البحث في كل الاعمدة من الخلية a2 ولغاية اخر صف بالعمود j رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر مايو 13 مشاركة قام بنشر مايو 13 (معدل) للتوضيح فقط لتجاوز حد 10 أعمدة لخاصية AddItem لعنصر التحكم، يتعين عليك استخدام إما خاصية القائمة المضافة من محتويات صفيف (يمكن أن تكون Range.Value) أو خاصية Rowsource المتصلة بنطاق ربما لو كان البحث في عمود محدد مسبقا ستكون الامور اسهل بكثير وفقًا لمتطلباتك.و لشكل الملف لديك يجب أن تفعل المصفوفة ثنائية الأبعاد ما تريد، ولاكن أثناء قيامك بالبحث في أوراق متعددة، ستحتاج إلى تحديد حجم المصفوفة بشكل صحيح عن طريق حساب إجمالي عدد التطابقات عبر جميع الأوراق أولاً قبل تعبئتها. صراحة ليس لي الكثير من الوقت لقضائه في هذا الأمر وتم اختباره فقط على بياناتك المرفقة - وبالتالي فإن محاولاتي لتحديث الكود الخاص بك قد تحتاج إلى بعض التعديل/ إعادة التفكير ولكن جرب ما إذا كان هذا سيفعل ما تريد Private Sub CommandButton1_Click() Dim sh As Worksheet Dim Cpt As String, SearchAddress As String Dim Found As Range, wsRangeArr() As Range Dim CountAllMatches As Long, CountMatch As Long Dim i As Long, r As Long, c As Long Dim Search As Variant, SearchRange As Variant Dim SearchSheetsArr As Variant, CopyArr() As Variant Const ColCount As Long = 12 SearchAddress = "A:J" SearchSheetsArr = Array("عين غزال", "الجبيهة", "أربد", "الزرقاء") '---------------------------------------------------------------------------------------------------------- Search = Me.TextBox1.Value If Len(Search) = 0 Then Exit Sub If IsDate(Search) Then Search = DateValue(Search): LookIn = xlFormulas Else LookIn = xlValues For Each sh In ThisWorkbook.Worksheets(SearchSheetsArr) CountMatch = Application.CountIf(sh.Range(SearchAddress), Search) If CountMatch > 0 Then i = i + 1: ReDim Preserve wsRangeArr(1 To i): Set wsRangeArr(i) = sh.Range(SearchAddress) 'العدد الإجمالي لجميع التطابقات في النطاقات CountAllMatches = CountAllMatches + CountMatch End If CountMatch = 0 Next sh On Error Resume Next If CountAllMatches > 0 Then ReDim CopyArr(1 To CountAllMatches, 1 To ColCount) 'أوراق البحث / النطاقات مع التطابقات r = 0 For Each SearchRange In wsRangeArr 'نطاق البحث Set Found = SearchRange.Find(Search, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False) Cpt = Found.Address Do 'ملء عناصر المصفوفة r = r + 1 For c = 1 To UBound(CopyArr, xlColumns) - 2 CopyArr(r, c) = SearchRange.Cells(Found.Row, c).Text Next c CopyArr(r, c) = Found.Address CopyArr(r, c + 1) = SearchRange.Parent.Name Set Found = SearchRange.FindNext(Found) Loop While Found.Address <> Cpt Set Found = Nothing Next SearchRange End If 'ملء مربع القائمة أو الإبلاغ عن عدم وجود تطابقات With Me.ListBox1 .ColumnCount = IIf(CountAllMatches > 0, ColCount, 1) .List = IIf(CountAllMatches > 0, CopyArr, Array("ما تحاول البحث عنه غير موجود في الاسواق")) .Font.Size = IIf(CountAllMatches > 0, 9, 24) .TextAlign = IIf(CountAllMatches > 0, fmTextAlignLeft, fmTextAlignCenter) End With End Sub Private Sub TextBox1_Change() If Len(Me.TextBox1) = 0 Then Me.ListBox1.Clear End Sub Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Me.TextBox1 = "": Me.ListBox1.Clear End Sub جديد v2.xlsm تم تعديل مايو 13 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
abed14092017 قام بنشر مايو 15 الكاتب مشاركة قام بنشر مايو 15 مشكور استاذ محمد هشام راح اجرب الكود بس شكل الكود معقدة شوي شاكر ذوق حضرتك رابط هذا التعليق شارك More sharing options...
أفضل إجابة حسونة حسين قام بنشر مايو 15 أفضل إجابة مشاركة قام بنشر مايو 15 وعليكم السلام ورحمه الله وبركاته تفضل اخى جرب هذا التعديل Option Explicit Private Sub CommandButton1_Click() Dim Ws As Worksheet, CEl As Range, Sheets_name As Variant, Sh, Temp() Dim Str As String, i As Long, j As Long, Lr As Long Str = Me.TextBox1.Value Sheets_name = Array("عين غزال", "الجبيهة", "الجبيهة", "أربد", "الزرقاء") i = 0 For Each Sh In Sheets_name Set Ws = ThisWorkbook.Sheets(Sh) Lr = Ws.Cells(Ws.Rows.Count, 9).End(xlUp).Row For Each CEl In Ws.Range("A2:J" & Lr) If InStr(CEl.Value, Str) > 0 Then i = i + 1 ReDim Preserve Temp(1 To 12, 1 To i) For j = 1 To 10 Temp(j, i) = Ws.Cells(CEl.Row, j).Value Next j Temp(11, i) = Ws.Name Temp(12, i) = CEl.Address End If Next CEl Next Sh If i = 0 Then MsgBox "ما تحاول البحث عنه غير موجود في الاسواق ", vbInformation + vbSystemModal, "نظام البطاقات الائتمانية - Search " TextBox1.Text = "" Else Temp = Application.Transpose(Temp) With Me.ListBox1 .ColumnCount = 12 .ColumnWidths = "96,96,96,96,140,96,96,96,96,96,96,96" .Clear .List = Temp End With End If End Sub جديد.xlsm 3 رابط هذا التعليق شارك More sharing options...
abed14092017 قام بنشر مايو 16 الكاتب مشاركة قام بنشر مايو 16 حسونة حسين اشكرا جدا يا صديقي راح اجرب الكود رابط هذا التعليق شارك More sharing options...
abed14092017 قام بنشر مايو 16 الكاتب مشاركة قام بنشر مايو 16 (معدل) استاذ حسونة حسين جربت الكود الكود رائع جداً و متتاز اشكرك جزيل الشكر تم تعديل مايو 16 بواسطه abed14092017 1 رابط هذا التعليق شارك More sharing options...
حسونة حسين قام بنشر مايو 16 مشاركة قام بنشر مايو 16 الشكر لله اخى الحمد لله الذي بنعمته تتم الصالحات 1 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر مايو 16 مشاركة قام بنشر مايو 16 (معدل) في 15/5/2024 at 01:02, abed14092017 said: راح اجرب الكود بس شكل الكود معقدة شوي يسعدنا حصولك على النتيجة المطلوبة لاكن للفائدة فقط لا غير . من الممكن تبسيط الكود لاكن هناك احتمالات واردة ربما لم تقم بتجربتها مثلا كالبحث عن قيمة فريدة او رقم يتضمن قيمة عشرية الكود الخاص بي تم انشاءه لتطابق القيم ليس للبحث بالتشابه هدا لانك طلبت البحث بجميع الاعمدة عن قيمة معينة او ربما لم استوعب طلبك جيدا .لقد فكرت مسبقا في اقتراح استادنا الغالي @حسونة حسين لاكن للاسف يعطي اخطاء جرب ادخال قيمة غير مكررة او تاريخ غير مكرر والبحث عنها او البحث عن رقم مثلا 3.530 ستلاحظ انه تم اظهار رسالة عدم تواجده . او تكراره في عدة اعمدة رغم وجوده مرة واحدة فقط على الملف بالتوفيق.......... جديد (1).xlsm تم تعديل مايو 16 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان