الـعيدروس

السلام عليكم الاستاذ الفاضل بن عليه بعد كم تجربه صار الفورم لايحذف من الورقة 2 ارجو التعديل على الكود

السلام عليكم جزاك الله كل خير قد توصلت الى حل ولاكن كودك مختصر جداً الف الف شكر

السلام عليكم الاخ الفاضل deebsaghee بالنسبه للفورم من اعداد الاستاذ الفاضل دغيدي لعله يطلع على موضوعك يقدر يفيدك لاكن عملت لك كود اذا وجد الرقم يطبع OK في ورقة متابعة المستندات هذا الكود في ThisWorkbook Private Sub Workbook_SheetActivate(ByVal Sh As Object) For l = 2 To 500 If Application.WorksheetFunction.CountIf(Sheets("البيانات").[f3:f1500], Sheets("متابعة السندات").Cells(l, 1)) > 0 Then Sheets("متابعة السندات").Range("a" & l).Offset(0, 1) = "OK" End If Next l End Sub ومرفق عليه الكود نموذج ادخال تجريبي1.rar

السلام عليكم سلمت اخي باسم سعيد على الملف المفيد تقبل مروري

السلام عليكم الاستاذ طارق محمود حفظك الله ورعاك ارجو من سيادتكم اكمال الفكره وهو (ص) و (م) توضح بمعنى الموجود في ورقة2 وغير موجود في ورقة 1 يجلبه لورقة 1 والذي موجود في ورقة2 وموجود في ورقة 1 يطبع في عمود (E) ورقة1 "غ" صـراحه النقطه هذي قفلت مخي من الصباح وانا احوس عليها ولم اوصل الى حل الله يوفقك والعذر منك والسموحه على كثرة الطلبات والسلام عليكم هذا الكود Sub gedwal_g() '================================================== '================================================== Dim Acc(999) As Variant, LstR As Range Sheets("ص").Activate lastRw1 = [B10000].End(xlUp).Row For x = 3 To lastRw1 i = i + 1 Acc(i) = Range("B" & x).Value Next x lastRw2 = [i10000].End(xlUp).Row For j = 3 To lastRw2 For x = 1 To i If Acc(x) = Range("i" & j) Then GoTo 10 Next x Set LstR = Sheets("ص").[B10000].End(xlUp).Offset(1, 0) Sheets("ص").Range("h" & j & ":k" & j).Copy LstR.PasteSpecial Paste:=xlPasteValues LstR.Offset(0, -1) = LstR.Offset(-1, -1) + 1 10 Application.CutCopyMode = False Next j x = Range("B3").End(xlDown).Row For l = 3 To x If Application.WorksheetFunction.CountIf(Sheets("ص").[i3:i512], Cells(l, 2)) > 0 Then Cells(l, 2).Offset(0, 3) = "r" End If Next l '================================================== ' عمل التنسيق من خليه '================================================== i = Range("d15000").End(xlUp).Row Range("o1").Copy Range("a" & i & ":c" & i).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats Range("ddd").Offset(1, 0).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False [a1].Select e = Range("b15000").End(xlUp).Row Range("q1").Copy Range("d" & e & ":e" & e).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats Range("fff").Offset(1, 0).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False [a1].Select End Sub ومرفق لكي تتضح لك الصورة بالشكل السليم تفضل مقارنة2.rar

السلام عليكم جزاك الله خير استاذ بن عليه ماكنت اتوقع انه بالسهوله ذي بارك الله فيك وزادك من علمه وفضله

السلام عليكم الاخوة والاساتذه الكرام لدي كود حذف على فورم اريد تعديل عليه اّلية الكود يحذف صف الاسم في ورقة 1 اريد الكود يبحث عن الاسم في ورقة 2 ويحذفه بمعنى ان وجد في ورقة 2 يقوم بحذفه مع الاسم الموجود في ورقة 1 وارجو عمل توضيح بسيط على الكود كي نتعلم الاليه اذا امكن هذا هو الكود Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim DADA As String Dim MYSH As Worksheet Dim PASSWORD As Integer On Error Resume Next PASSWORD = InputBox("الرجاء ادخال الرقم المصرح لك به لاتمام العمليه", "إدخال تصريح لحذف موظف مع جميع بياناته") If PASSWORD <> "1234" Then MsgBox "تم الغاء الامر" Else If MsgBox(":لقد طلبت حذف البيانات التالية" & vbNewLine & "" & vbNewLine & "إسـم المـوظف: " & TextBox3 _ & vbNewLine & "" & vbNewLine & "رقم الحساب: " & TextBox2 & vbNewLine & "" & vbNewLine & "" _ & vbNewLine & "فهل تود الإستمرار؟", vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then A = Application.WorksheetFunction.Match(ListBox1, RNG1, 0) Application.ScreenUpdating = False MsgBox " تم حذف السجل الخاص ب" & ListBox1 & " بنجاح", vbInformation, "تم الحذف" Application.ScreenUpdating = False DADA = ListBox1.List(ListBox1.ListIndex, 8) Set MYSH = Sheets("فترة صباحية") With MYSH .Application.Range(DADA).Rows.Select .Range(DADA).EntireRow.Delete Application.ScreenUpdating = True End With End If End If ListBox1.Clear TextBox4.Text = "" TextBox4.SetFocus End Sub والسلام عليكم حذف_اسم.rar

السلام عليكم الاستاذ طارق محمود كفيت ووفيت اكوادك كلها جميله ومختصره ماشاء الله الله يوفقك جربت الكود شغال 100% جزاك الله كل خير

السلام عليكم الاخوة الافاضل كثرة طلباتي وارجو ان تتسع صدوركم اريد كود مقارنة بين عمود ورقة1 وعمود في ورقة2 شرح مختصر والمطلوب موضح بالتفصيل على المرفق والسلام عليكم كود مقارنه.rar

سلم اخي الزير من طيب اصلك

السلام عليكم احبابي مشرفين واعضاء وزوار منتدانا الحبيب لدي كود حذف صف الكود المكرر مااريده هو ان قبل حذف الصف ينسخ بياانات عمود D , E ويلصقها بالصف الباقي الشبيه الذي لم يحذف هذا مااراه ومن لديه فكره اسهل تتماشى مع مااريده هذا هو الكود Sub abood() lastr = [A10000].End(xlUp).Row For i = 4 To lastr If Cells(i, "c") <> "a" Then Range("A" & i & ":c" & i).Copy (Sheets("ص").[A10000].End(xlUp).Offset(1, 0)) End If Next i aal = [A10000].End(xlUp).Row For g = 4 To aal If Sheets("فترة صباحية").Cells(g, 4) <> "" Then Sheets("ص").Cells(g, 2).Offset(-1, 3).Value = "غ" End If Next g Application.ScreenUpdating = False ddd = [A10000].End(xlUp).Row For abood = 3 To ddd If Sheets("ص").Cells(abood, 2) = Sheets("ص").Cells(abood, 2) Then Sheets("ص").Cells(abood, 2).EntireRow.Delete End If Next abood On Error Resume Next Application.ScreenUpdating = True End Sub ارجو الرد من خبراء الاكواد لاني من يومين احاول اعدل عليه ولم انجح بحاولاتي اساس الكود للاستاذ طارق محمود جزاه الله كل خير

السلا م عليكم بعد اذن استاذنا الحبيب عبدالله المجرب بمعنى تطبيق ماقاله تفضل المرفق بالتنسيق الشرطي شرطي.rar

السلام عليكم الاخ الفاضل علا كل مافي الامر كان يقراء من الصف رقم (6) عدلته من صف رقم (3) بعد روؤ س الاعمدة انشاء الله اكون وفقت في فهم ماتريدة تفضل فورم ادخال واستدعاء قيد1.rar

السلام عليكم ارجو التعديل على الكود لما يتناسب مع ملفي اريد الكود يقوم بترحيل الفارغ الى ورقة (ص-م) ويطبع مقابل كل اسم في عمود (ص) غ في ورقة (ص-م) ونفس الكود في ورقة الفترة المسائية يقوم بترحيل الفارغ على الاسماء الموجوده في شيت ص-م واذا لم يجد رقم الكود يضيفه بعد اخر صف ويطبغ غ في عمود (م) بمعنى ترحيل الفترة المسائية يختلف عن الفترة الصباحيه و يعمل عملية تحقق ارجو ان اكون وفقت بتوضيح طلبي ملحوظة : التحقق يكون على رقم الكود هذا كود الفترة الصباحية Sub shift_empty() lastr = [A10000].End(xlUp).Row Sheets("ص-م").Range("A3:A10000").EntireRow.Delete Shift:=xlUp For i = 4 To lastr If Cells(i, "c") <> "a" Then Range("A" & i & ":c" & i).Copy (Sheets("ص-م").[A10000].End(xlUp).Offset(1, 0)) End If Next i aal = [A10000].End(xlUp).Row For g = 4 To aal If Sheets("فترة صباحية").Cells(g, 4) <> "" Then Sheets("ص-م").Cells(g, 2).Offset(-1, 2).Value = "غ" End If Next g End Sub كود الفترة المسائية Sub abood() aal = [A10000].End(xlUp).Row For g = 4 To aal If Sheets("فترة مسائية").Cells(g, 4) <> "" Then Sheets("ص-م").Cells(g, 2).Offset(-1, 3).Value = "غ" End If Next g End Sub والمرفق وعليه الاكواد ترحيل3.rar

السلام عليكم عيدكم مبارك اعاده الله علينا وعليكم باليمن والبركه تقبل الله منا ومنكم صالح الاعمال توصلت لما اريد وذلك بالغاء الليست بوكس بحث عن طريق TextBox وعند النقر انتر من الكيبورد يحفز الفتره (البحث برقم الحساب) ارجو منكم تعديل الكود ليبحث في كل الاعمدة والسلام عليكم ترحيل1.rar

بارك الله فيك استاذ احمد حمور انشاء الله تزبط معاك عشمي كبير فيكم وفقك الله

السلام عليكم ربما لم يفهم المطلوب ارفقت الملف وفيه الفورمز ومااريده عند البحث برقم الحساب وظهور رقم الحساب في listbox نتيجة واحدة اضغط انتر بدل النقر بالماوس ارجو ان اكون وضحت ترحيل.rar

السلام عليكم الاستاذ عبدالله المجرب كود عملي ويحتاجه الكثير تألق وتقدم بخطى سريعه وفقك الله تقبل مروري

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

السلام عليكم استاذ يحياوي ماشاء الله روائع اليحياوي وننتظر منك المزيد وفقك الله تقبل مروري

السلام عليكم مرحبا بالجميع الف الف مبروك على النيو لك الجديد استايل ولااروع الله يقدر الجميع على خدمة اعضاء وزوار الموقع الرائد وفقك الله الجميع لما فيه الخير والعذر والسموحه من الجميع لعدم تواجدي بينكم وذلك لانشغالي وعدم مقدرتي دخول الانترنت من اساسه الا ساعه بعد الثانيه ليلا الى ان ييسر الله الحال والسلام عليكم

سلمت يمناك استاذ احمد حمور ابو عبدالله انا شخصيا استفدت منك الكثير الله يزيدك من فضله وييسر لك امور دنياك تقبلو مروري

السلام عليكم الاستاذ القدير المعصتم تسلم على الاضافة وفقك الله طرت في بالي اضافة وزبطت معي ارجو ان تستفيدو منها استعنت بفورم البحث من عمل الاستاذ الكبير خبور خير وفقه الله للبحث السريع وعمل تحفيز للاسم والسلام عليكم ترحيل.rar

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

بورك فيك استاذ طارق كود جميل جدا مختصر وفقك الله وجعله في ميزان حسناتك انشاء الله