عبدالله باقشير

جزاك الله خيرا و بارك فيك وشهركم مبارك وكل عام وانتم بخير تقبل تحياتي وشكري

شكرا لمرورك بارك الله فيك وشهركم مبارك وكل عام وانتم بخير تقبل تحياتي وشكري

السلام عليكم الله يبارك فيك اخي الحبيب عبدالله وعلى فكرة الدالة SumIf تقوم بذلك اسرع المرفق 2003 سوق3.rar

السلام عليكم ايضا الذي تطلع عنده رسالة بالخطأ عند السطر .ColumnWidths = wColmn يقوم بحذف هذا السطر من الكود او يعمل شرطة احادية قبل السطر ليلغي قراءة هذا السطر وستنتهي المشكلة ان شاء الله لان هذا السطر يقوم بوضع مقاسات الاعمدة من النطاق يعني هو مش مؤثر في الكود اصلا ستبقى المقاسات الافتراضية للست ودمتم في حفظ الله

السلام عليكم ورحمة الله وبركاته في المشاركات اعلاه وجدت ان السؤال الاكثر حول كيفية البحث ليشمل نتائج اوسع والحل موجود اصلا وهو استخدام النجمة وعلامة الاستفهام وقد اوجدت زرين لهذا الغرض ============================================================== أحرف البدل يمكن استخدام أحرف البدل التالية كمعايير مقارنة لعوامل التصفية وعند البحث عن محتوى واستبداله. * (علامة نجمية) أي عدد من الأحرف على سبيل المثال، يتم العثور على "شمال شرق" و"جنوب شرق" عند كتابة *شرق ؟ (علامة استفهام) أي حرف مفرد على سبيل المثال، يتم العثور على "سمير" و"سفير" عند كتابة س؟ير ==============================================================

السلام عليكم ورحمة الله وبركاته احبتي في الله الاخ الفاضل / عباس السماوي__________ حفظه الله الاخ الفاضل / yousef_kaf__________ حفظه الله الاخ الفاضل / basem said__________ حفظه الله الاخ الفاضل / hussien2222__________ حفظه الله الاخ الفاضل / يحياوي__________ حفظه الله الاخ الفاضل / عبدالله المجرب__________ حفظه الله الاخ الفاضل / ابن بنها__________ حفظه الله الاخ الفاضل / سعد عابد__________ حفظه الله الاخ الفاضل / tahar1983__________ حفظه الله الاخ الفاضل / jjebril__________ حفظه الله الاخ الفاضل / alzubari__________ حفظه الله الاخ الفاضل / ابو تميم__________ حفظه الله الاخ الفاضل / مصطفى السمري__________ حفظه الله شهركم مبارك وكل عام وانتم بخير اكرمكم الله واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة تقبلوا تحياتي وشكري

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

السلام عليكم شاهد المرفق 2003 سوق.rar

انا لم اجد كلمات تناسب هذا الخلق الحسن الله يكرمك دنيا واخرة وتقبل الله منا ومنكم صالح الأعمال ويجعلك من مغفوري الذنوب والمعتوقين من النار في هذا الشهر الكريم تقبل تحياتي وشكري

جزاك الله خيرا وبارك فيك ورمضان كريم بالنسبة للمشكلة في حدث الفورم UserForm_Activate استبدل السطر 7 بهذا السطر wColmn = wColmn & IIf(Len(wColmn), Chr(59), "") & ww جرب واشعرنا بالنتيجة تقبل تحياتي وشكري

جزاك الله خيرا وبارك فيك تقبل تحياتي وشكري

السلام عليكم كل عام وانتم بخير هدية الشهر الكريم فورم بحث و تصفية بامكانية التعديل مرن لكل المستخدمين لا عليك سوى التعديل في كود اظهار الفورم ضع نطاق رؤوس الاعمدة و يصبح جاهز للاستخدام ' اسم نطاق رؤوس الاعمدة ' او عنوان النطاق ملحوق باسم الورقة Private Const MyTopColmnRng As String = "البيانات!$B$3:$L$3" المرفق 2003 2007 فورم بحث بامكانية التصفية.rar ودمتم في حفظ الله ============================================================== ملحوظة: في المشاركات ادناه وجدت ان السؤال الاكثر حول كيفية البحث ليشمل نتائج اوسع والحل موجود اصلا وهو استخدام النجمة وعلامة الاستفهام وقد اوجدت زرين لهذا الغرض أحرف البدل يمكن استخدام أحرف البدل التالية كمعايير مقارنة لعوامل التصفية وعند البحث عن محتوى واستبداله. * (علامة نجمية) أي عدد من الأحرف على سبيل المثال، يتم العثور على "شمال شرق" و"جنوب شرق" عند كتابة *شرق ؟ (علامة استفهام) أي حرف مفرد على سبيل المثال، يتم العثور على "سمير" و"سفير" عند كتابة س؟ير ============================================================== ايضا الذي تطلع عنده رسالة بالخطأ عند السطر .ColumnWidths = wColmn يقوم بحذف هذا السطر من الكود او يعمل شرطة احادية قبل السطر ليلغي قراءة هذا السطر وستنتهي المشكلة ان شاء الله لان هذا السطر يقوم بوضع مقاسات الاعمدة من النطاق يعني هو مش مؤثر في الكود اصلا ستبقى المقاسات الافتراضية للست ==============================================================

تفضل جرب الكود التالي: ' عدد الصفوف التي تريدها Private Const ContRow As Long = 20 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("a2").Resize(ContRow, 104)) Is Nothing Then If IsEmpty(Target) Then If Me.CheckBox1.Value Then Target.Offset(0, 104).ClearContents Else With Target.Offset(0, 104) .Value = Date .EntireColumn.AutoFit End With End If End If End Sub المرفق 2003 test.rar

السلام عليكم وكل عام وانتم بخير Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("a1:a10000")) Is Nothing Then VBA.Calendar = vbCalGreg If IsEmpty(Target) Then Target(1, 2).ClearContents Else With Target(1, 2) .Value = Date .EntireColumn.AutoFit End With End If End If End Sub

اكرمك الله في الدارين وشهركم مبارك تقبل تحياتي وشكري

السلام عليكم بارك الله فيك اخي الحبيب رجب ولاثراء الموضوع Sub kh_Start() Dim Ar Dim r As Integer, c As Integer, i As Integer Dim st As String [H3:K100].ClearContents For r = 2 To Range("A" & Rows.Count).End(xlUp).Row If CStr(Cells(r, 1)) = CStr([H2]) Then st = CStr(Cells(r, 2)) If WorksheetFunction.CountIf(Range("H3").Resize(i + 1), st) = 0 Then i = i + 1 Ar = mTest(CStr([H2]), st) For c = 1 To 4 Range("H3").Cells(i, c).Value = Ar(c - 1) Next End If End If Next End Sub Function mTest(nT As String, nS As String) As Variant Dim x As Integer, xx As Integer Dim iMX As Long, iMN As Long For x = 2 To Range("A" & Rows.Count).End(xlUp).Row If CStr(Cells(x, 1)) = nT Then If CStr(Cells(x, 2)) = nS Then xx = xx + 1 If xx = 1 Then iMN = Val(Cells(x, 3)) If Val(Cells(x, 3)) < iMN Then iMN = Val(Cells(x, 3)) If Val(Cells(x, 3)) > iMX Then iMX = Val(Cells(x, 3)) End If End If Next mTest = Array(nS, iMN, iMX, xx) End Function يعمل الكود تلقائيا عند التغيير في الخلية H2 المرفق 2003 استخراج اقسام المدرسة وارقام الجلوس لكل قسم .rar

السلام عليكم اخي الحبيب / رجب حفظك ربي احيانا نحتاج في الاكواد الى ثوابت معية سيتم الاعتماد عليها في تشغيل الكود وقد تكون هذه المعلومات عبارة عن جدول بسيط في الملف وستعمل كود لاخذ بياناته هذا جعلته نموذج لاستخدام ثابت نصي بدلا من الجدول اللي في الملف اما بالنسبة Evaluate شاهد الرابط اداه http://msdn.microsof...office.11).aspx تقبل تحياتي وشكري

السلام عليكم الاخ الفاضل / ابو ردينه -----حفظه الله وبارك فيك وحفظك من كل مكروه تقبل تحياتي وشكري

السلام عليكم وشهركم مبارك وكل عام وانتم بخير استخدام ثابت نصي كصفيف ذو بعدين هذا الثابت النصي Private Const tList As String = """ عربي""" & "," & 26 & "," & 22 & ";" & _ """رياضيات""" & "," & 35 & "," & 31 & ";" & _ """ دراسات""" & "," & 44 & "," & 40 & ";" & _ """ انجليزى""" & "," & 53 & "," & 49 & ";" & _ """ علوم""" & "," & 64 & "," & 60 & ";" & _ """ مجموع""" & "," & 65 & "," & 70 & ";" & _ """ دين""" & "," & 82 & "," & 78 يتم تحويله الى صفيف بهذا السطر xArray = Evaluate("{" & tList & "}") شاهدوا المرفق 2003 2007 ثابت نصي كصفيف.rar

وعليكم السلام انت لخبطت الكود وكنسلت خلية الارتباط عموما هذا طلبك وبلاش الالوان والحاجات اللي تثقل الملف علشان يعمل معاك تمام Option Explicit '============================================= ' اسم ورقة وضع نتائج البحث Const sNamePast As String = "نتائج البحث" ' اسم ورقة البحث Const sNameFind As String = "البحث في المكتبة" '============================================= Sub Kh_Find() Static MySve As String Dim MyTextFind As Variant Dim FirstAddress As String Dim sFind As Worksheet Dim RngPast As Range Dim RngFind As Range Dim cel As Range Dim i As Long Dim ii As Long On Error GoTo 1 '==================================== ' الصف الاول من خلايا وضع النتائج Set RngPast = Worksheets(sNamePast).Range("B3:G3") '==================================== With RngPast .Worksheet.Activate .Range("A1").Activate .Offset(1, 0).Resize(.Worksheet.UsedRange.Rows.Count).EntireRow.Delete .ClearContents End With MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث", MySve, 100, 100, , , 2) If MyTextFind = "" Or MyTextFind = False Then GoTo 1 '==================================== Set sFind = Worksheets(sNameFind) Set RngFind = sFind.Columns(3).Cells '==================================== '==================================== Application.ScreenUpdating = False Application.Calculation = xlCalculationManual '==================================== Set cel = RngFind.Find(MyTextFind, LookIn:=xlValues) If Not cel Is Nothing Then FirstAddress = cel.Address Do ii = cel.Row If ii = 1 Then GoTo NX i = i + 1 With RngPast .Cells(i, 1) = sFind.Cells(ii, "A").Value .Cells(i, 2) = sFind.Cells(ii, "B").Value .Cells(i, 3) = sFind.Cells(ii, "C").Value .Cells(i, 4) = sFind.Cells(ii, "E").Value .Cells(i, 5) = sFind.Cells(ii, "F").Value .Cells(i, 6) = sFind.Cells(ii, "H").Value kh_AddHlink .Cells(i, 1), ii End With NX: Set cel = RngFind.FindNext(cel) Loop While Not cel Is Nothing And cel.Address <> FirstAddress End If '==================================== If i Then MySve = MyTextFind With RngPast .AutoFill .Resize(i), xlFillFormats End With End If '==================================== 1: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If Err Then MsgBox "Err.Number : " & Err.Number: Err.Clear End If Set sFind = Nothing Set RngPast = Nothing Set RngFind = Nothing Set cel = Nothing End Sub ' اضافة ارتباط تشعيبي Sub kh_AddHlink(HRng As Range, iR As Long) Dim sAdr As String sAdr = "'" & sNameFind & "'!" & Range("A" & iR).Address HRng.Worksheet.Hyperlinks.Add HRng, "", sAdr, sAdr End Sub كود بحث في عدة اوراق.rar

العمود الذي يبحث فيه السطر With sFind.Range("C1:C65000") الورقة التي تبحث فيها ​Set sFind = Worksheets("البحث في المكتبة") البيانات الذي اريد ان استخرجها الاسطر MyAry(1, i) = ii MyAry(2, i) = sFind.Cells(ii, "A").Value MyAry(3, i) = sFind.Cells(ii, "B").Value MyAry(4, i) = sFind.Cells(ii, "C").Value MyAry(5, i) = sFind.Cells(ii, "E").Value MyAry(6, i) = sFind.Cells(ii, "F").Value اول سطر خاص برقم الصف الذي نستخدمة للارتباط MyAry(1, i) = ii اما البقية فهي الخلايا المطلوبة تعيين عدد الاعمدة هنا ReDim Preserve MyAry(1 To 6, 1 To i) الرقم 6 الاول لرقم الصف ما لويش دخل بالخلايا البقية وهي خمسة للخلايا عند الزيادة او النقصان تغير الرقم 6 مثلا عند زيادة خلية اخرى تغير الرقم 6 الى 7 وتضيف سطر آخر للعمود المطلوب مثلا MyAry(7, i) = sFind.Cells(ii, "G").Value بداية الكتابة مثلا من البداية الصف الثاني والعمود الثاني هذا السطر مثلا معناه بداية من A2 بمقاس 2 صف و6 اعمدة .Range("A2").Resize(2, 6)

حفظك ربي واكرمك وازال همك وجزاك خيرا وبارك فيك تقبل ازكى تحياتي وباقات شكري وتقديري

السلام عليكم في المرفق 2003 توضيح عن الارقام المستخدمة مع MSGBOX MSGBOX.rar

السلام عليكم الاخ الحبيب / ابو ردينة ----------------حفظك الله وجزاك خيرا وبارك فيك تقبل تحياتي وشكري

السلام عليكم الاخ الحبيب / رجب جاويش ------------حفظه الله الاخ الحبيب / عبدالله المجرب ------------حفظه الله نقاش رائع امتياز في الاسلوب والسؤال والجواب ولا ننسى الخلق الحسن ساضيف معلومة عن iif ان بامكانك اختبار الشرط بها في سطر تنفيذ التعليمات MsgBox IIf(r, "عدد نتائج البحث : " & r, "لا توجد نتائج للبحث "), 524288 + 1048576, "النتيجة" جعلني افكر في استخدام هذا النهج كاسلوب تعليمي بمساعدتكما في المرات القادمة ان شاء الله جزاكم الله خيرا وبارك فيكم تقبلوا تحياتي وشكري