ابراهيم الحداد

السلام عليكم ورحمة الله اربط هذا الكود بالزر الموجود بالورقة الشهادة Sub PrintCall() Dim ws As Worksheet, Sh As Worksheet, Rng As Range Dim LR As Long, i As Long, p As Long Dim x As Integer, WF As Variant Dim Nam, Sm Set ws = Sheets("بيان") Set Sh = Sheets("شهادة") Set WF = WorksheetFunction LR = ws.Range("B" & Rows.Count).End(3).Row Set Rng = ws.Range("A2:C" & LR) p = 2 x = Sheet6.Shapes("Spinner 3").ControlFormat.Value i = (x - 1) * 4 + 1 Do While p <= 32 Sh.Range("H" & p) = i Nam = WF.VLookup(i, Rng, 2, 0) Sh.Range("C" & p + 2) = Nam Sm = WF.VLookup(i, Rng, 3, 0) Sh.Range("H" & p + 2) = Sm p = p + 10 i = i + 1 Loop ActiveSheet.PrintOut From:=1, To:=1, Copies:=1 End Sub

السلام عليكم ورحمة الله هذا الكود لاستدعاء اسم السيارة بناءا على رقمها اما موضوع تحويل التاريخ من هجرى الى ميلادى اتمنى ان بساعدك فى احد الاخوة لضيق الوقت لدى Sub CarsNames() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long Dim Car As String, CarNum As String Dim WF As Variant Set ws = Sheets("Sheet1") Set Sh = Sheets("Plate_No") Set WF = WorksheetFunction LR = ws.Range("A" & Rows.Count).End(xlUp).Row i = 6 Do While i <= LR CarNum = ws.Range("J" & i).Value Car = WF.Index(Sh.Range("A2:B" & Sh.Range("B" & Rows.Count).End(3).Row), _ WF.Match(CarNum, Sh.Range("B2:B" & Sh.Range("B" & Rows.Count).End(3).Row), 0), 1) ws.Range("I" & i) = Car i = i + 1 Loop End Sub

السلام عليكم ورخمة الله تم استخدام Sheet3 كورقة مساعدة يمكنك اخفاءها اذا اردت و قد تركت ظاهرة ليمكنك التعديل عليها اليك الملف كشف بأسماء العاملين بالوحدة.xlsx

السلام عليكم ورحمة الله ضع المعادلة التالية فى اول خلية ثم اضغط Ctrl + Shift + Enter ثم اسحب المعادلة افقيا و رأسيا =IFERROR(INDEX(البيانات!$B$686:$I$712;MATCH(($B2&"*?");البيانات!$B$686:$B$712&البيانات!C$686:C$712;0);COLUMN()-1);"")

السلام عليكم ورحمة الله ضع المعادلة الاولى فى العمود المخصص للتاريخ =IFERROR(INDEX(الحراسة!$F$4:$L$20;SMALL(IF(INDIRECT($C$3;1)<>"";ROW(INDIRECT($C$3;1)));ROW($A1))-3;1);"") اما المعادلة الثانية فضعها فى العمود المخصص للاسماء =IFERROR(INDEX(الحراسة!$F$4:$L$20;SMALL(IF(INDIRECT($C$3;1)<>"";ROW(INDIRECT($C$3;1)));ROW($A1))-3;MATCH($C$3;الحراسة!$F$3:$L$3;0));"") و فى كلتا الحالتين لا تنسى الضغط على Ctrl+Shft+Enter قبل السحب لاسفل

السلام عليكم ورحمة الله ضع هذه المعادلة فى الخلية C28 ثم اضغط Ctrl+Shift+Enter =IFERROR(INDEX($B$2:$D$25;SMALL(IF($B$2:$B$25=$B28;ROW($B$2:$B$25));ROW(A1));2);"") ضع نفس المعادلة فى الخلية D28 و بدل الرقم 2 فى المعادلة السابقة برقم 3 و لا تنسى الضغط على Ctrl+Shift+Enter ايضا و السحب حتى آخر خلية و هكذا مع بقية الجداول

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

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

اللام عليكم ورحمة الله المعادلة الاولى للشهر الاول =COUNTIF($C$2:$C$15;"*"&$B20&"*") و المعادلة الثانية للشهر الثانى =COUNTIF($D$2:$D$15;"*"&$B20&"*")

السلام عليكم ورحمة الله اجعلى الكود هكذا Private Sub CommandButton1_Click() Dim ws As Worksheet, LR As Long, i As Long Set ws = Sheets("Sheet1") LR = ws.Range("A" & Rows.Count).End(3).Row Application.ScreenUpdating = False For i = 1 To 22 ws.Cells(LR + 1, i).Value = Me.Controls("TextBox" & i).Value Me.Controls("TextBox" & i) = vbnulstring Next ws.Range("E2").Value = Me.ComboBox1.Value ws.Range("E3").Value = Me.TextBox25.Value ws.Range("I2").Value = Me.TextBox26.Value ws.Range("I3").Value = Me.TextBox27.Value Me.ComboBox1 = "" Me.TextBox25.Value = "" Me.TextBox26.Value = "" Me.TextBox27.Value = "" Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله اكتب هذه المعادلة هى اول خلية مقابلة للرقم المطلوب ثم اضغط Ctrl + Shift + Enter ثم اسحب نزولا لاخر خلية تريدها =IFERROR(IF(SMALL(IF($B$5:$G$5=$C12;COLUMN($B$5:$G$5));1)>0;"a";"");"x")

السلام عليكم ورحمة الله ضعى الكودين الآتيين فى حدث الفورم مع مراعاة ان اعيدى ترتيب التكست بوكس الاولى من 1 الى 18 حتى يعمل معك الكود بشكل صحيح هذا و الله ولى التوفيق Private Sub CommandButton1_Click() Dim ws As Worksheet, LR As Long, i As Long Set ws = Sheets("Sheet1") LR = ws.Range("A" & Rows.Count).End(3).Row Application.ScreenUpdating = False For i = 1 To 22 ws.Cells(LR + 1, i).Value = Me.Controls("TextBox" & i).Value Next ws.Range("E2").Value = Me.ComboBox1.Value ws.Range("E3").Value = Me.TextBox25.Value ws.Range("I2").Value = Me.TextBox26.Value ws.Range("I3").Value = Me.TextBox27.Value Application.ScreenUpdating = True End Sub Private Sub UserForm_Initialize() Me.ComboBox1.AddItem "نقدى ": Me.ComboBox1.AddItem "اجل" Me.ComboBox1.AddItem "دين ق": Me.ComboBox1.AddItem "دين ط" End Sub

السلام عليكم ورحمة الله تم تعديل الكود ارجو ان يكون هو المطلوب Sub FinalResult() Const Res = "ناجح ومنقول إلى الصف السابع بتقدير" Dim ws As Worksheet Dim LR As Long, I As Long, x As Integer Dim Mad As String t = Timer Application.ScreenUpdating = False Set ws = Sheets("ك.د.سد") On Error Resume Next ws.Range("F" & I + 3).ClearContents LR = ws.Range("C" & Rows.Count).End(3).Row I = 11 Do While I <= LR If ws.Cells(I, 33) = "ناجح" Then ws.Cells(I + 3, 6).Value = Res & "" & ws.Cells(I, 29).Value ElseIf ws.Cells(I, 33) = "له دور ثان في" Then x = 38 Do While x <= 50 Mad = Mad & "-" & ws.Cells(I, x).Value ws.Cells(I + 3, 6).Value = ws.Cells(I, 33).Value & " " & Mad x = x + 2 Loop End If Mad = "" I = I + 4 Loop Application.ScreenUpdating = True 'MsgBox Round(Timer - t, 2) End Sub

السلام عليكم ورحمة الله سبب المشكلة لديك بالملف هو ان تسطير الجدول بخاصية الجداول الجاهزة و لابد من التخلص منها و اذا اردت ذلك فعليك بالخطوات الاتية : 1 - تحديد اى خلية بالجدول و لتكن الخلية "A2" سيظهر لك تبويب جديد يسمى "Design" 2 - اضغط على العبارة الاتية "Convert To Range" ستظهر لك رسالة اضغط "Yes" و سينتهى الامر 3 - يمكنك جعل التنسيق من خلال التسيق الشرطى او بأى شكل آخر ان شئت

السلام عليكم ورحمة الله كود للبحث بالرقم القومى و تلوين الاسم Sub SearchData() Dim ws As Worksheet, Sh As Worksheet Dim lr As Long, i As Long Dim data Set Sh = Sheets("البحث") data = Sh.Range("C7").Value Application.ScreenUpdating = False For Each ws In Worksheets If ws.Name <> "البحث" Then lr = ws.Range("A" & Rows.Count).End(3).Row i = 8 Do While i <= lr If ws.Cells(i, 1) = data Then Sh.Range("C8").Value = ws.Cells(i, 2).Value Sh.Range("C9").Value = ws.Cells(i, 3).Value Sh.Range("C10").Value = ws.Cells(i, 4).Value Sh.Range("C11").Value = ws.Cells(i, 5).Value ws.Cells(i, 1).Interior.ColorIndex = 10 End If i = i + 1 Loop End If Next Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله استخدم هذا الكود Sub ClearData() Dim ws As Worksheet, Lr As Long Set ws = Sheets("ورقة2") Lr = ws.Range("B" & Rows.Count).End(3).Row ws.Range("B2:C" & Lr, "E2:E" & Lr).ClearContents ws.Range("J2:K" & Lr, "N2:T" & Lr).ClearContents End Sub

السلام عليكم ورحمة الله اخى الكريم اشكرك على حسن اخلاقك يمنكنك استبدال هذا الجزء من المعادلة COUNTA($A$2:$A$7) بهذا الجزء COUNTA(B$2:$B7)

السلام عليكم ورحمة الله اخى الكريم يمكنك تعديل هذا الجزء من المعادلة بحيث لا تتخطى الصف الذى تطهر فيه النتائج =INDEX($A$2:$D$6;COUNTA($A$2:$A$6) مثلا ان الرقم 6 فى المعادلة يمكنك تغييره الى 10 او 50 او 100 او 1000 وهكذا الى آخر نطاق قد تظهر فيه البيانات و بذلك سوف تطهر لديك كل النتائج

السلام عليكم ورحمة الله اكتب المعادلة التالية فى الخلية "B13" ثم اسحبها طولا و عرضا =INDEX($A$2:$D$6;COUNTA($A$2:$A$6)-COLUMN()+2;MATCH($A13;$B$1:$D$1;0)+1)

السلام عليكم ورحمة الله استخدم هذا الكود بعد تحويل تنسيق العمود "E" الى "Text" Sub ConcaText() Dim LR As Long, i As Long LR = Range("G" & Rows.Count).End(3).Row i = 3 Do While i <= LR Range("E" & i).Value = Range("H" & i).Value & " / " & Range("G" & i).Value i = i + 1 Loop End Sub

السلام عليكم ورحمة الله تفضل LaLiga-2011-2012-V1.5.xls

السلام عليكم ورحمة الله جرب هذا الكود Sub GetName() Dim ws As Worksheet, Arr As Variant Dim LR As Long, i As Long Dim j As Long, x As Long Application.ScreenUpdating = False Set ws = Sheets("ورقة2") LR = ws.Range("A" & Rows.Count).End(3).Row Arr = ws.Range("A13:AA" & LR).Value x = 3 Do While x <= 27 For i = 1 To UBound(Arr, 1) For j = 1 To UBound(Arr, 2) If ws.Cells(1, x) = Arr(i, j) Then ws.Cells(2, x) = Arr(i, 1) End If Next Next x = x + 1 Loop Application.ScreenUpdating = True End Sub

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

السلام عليكم ورحمة الله يمكنك الغاء (مسح) هذا السطر بالكود و جميع الاسطر المشابهة له فى نفس الكود المدرج بالمشاركة الاولى .Range("A" & M) = M - 3

السلام عليكم ورحمة الله استخدمى هذا الكود Sub HideRows() lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row - 2 For f = lr To 3 Step -2 x = WorksheetFunction.Sum(Sheet1.Range(Cells(f, 2), Cells(f, 7))) If x = 0 Then Sheet1.Range(Cells(f - 1, 2), Cells(f, 7)).Rows.Hidden = True End If Next End Sub