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

السلام عليكم ورحمة الله تم حفظ الملف بامتداد مختلف لخلل فى القائمة المنسدلة اليك الملف Liste.rar

السلام عليكم ورحمة الله اكتب هذا الكود فى حدث الورقة 2 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$H$15" Or Target.Address = "$H$17" Then For R = 4 To 9 If Target.Value = Sheet1.Cells(R, 3).Value Then Target.Interior.ColorIndex = Sheet1.Cells(R, 3).Interior.ColorIndex End If Next End If End Sub

السلام عليكم ورحمة الله تفضل اخى الكريم حالة.rar

السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False On Error Resume Next Dim R As Integer LR = Range("A" & Rows.Count).End(xlUp).Row + 1 If Not Intersect(Target.Cells(1, 1), Union(Range("B3:B4000"), Range("o3:o5000"))) Is Nothing Then R = Target.Row If Cells(R, "B").Value <> "" Then If Cells(LR - 1, "A").Value <= 99 Then Cells(R, "A").Value = R + 44 'محتاج التعديل على الكود حيث يبداء الترقم من 44 ويتوقف عن الترقيم عند الرقم 100 Else End If End If End If Application.ScreenUpdating = True On Error GoTo 0 End Sub

السلام عليكم ورحمة الله تفضل حالة.rar

السلام عليكم ورحمة الله تفضل Book1.rar

السلام عليكم ورحمة الله تفضل اخى الكريم هشام 22.rar

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

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

السلام عليكم ورحمة الله تفضل أخى الكريم المثال.rar

السلام عليكم ورحمة الله تم التعديل Nouveau dossier.rar

السلام عليكم ورحمة الله تكتب هكذا =A4 *$B$4 وتسحب نزولا

السلام عليكم ورحمة الله تفضل اخى الكريم Nouveau dossier.rar

السلام عليكم ورحمة الله تم تعديل الكود ولكنه يستغرق وقتا فى التنفيذ استبدل الكود السابق بهذا الكود Sub Tra_Data3() Application.ScreenUpdating = False LR = Sheet12.Range("B" & Rows.Count).End(xlUp).Row For R = 13 To LR For F = 13 To Cells(Rows.Count, "C").End(xlUp).Row If Cells(F, "C") = Sheet12.Cells(R, "B") Then Sheet12.Range("C" & R).Range("A1:D1").Copy Range("D" & F).PasteSpecial xlPasteValues End If Next Next Application.CutCopyMode = False MsgBox " تم بحمد الله " Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله اكتب المعادلة التالية فى الخلية "B2" ثم اسحب نزولا =SUMIF(Sheet1!$A$1:$A$24;$A2;Sheet1!$B$1:$B$24)

السلام عليكم ورحمة الله تم استبدال المعادلة بكود لنسخ البيانات المطلوبة Book1.rar

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

السلام عليكم ورحمة الله انسخ هذا الكود فى موديول جديد وخصص له زر Sub SumCols() LR = Range("A" & Rows.Count).End(xlUp).Row + 1 For R = 2 To LR Step 2 x = 0 For C = 8 To 1 Step -1 x = x + Cells(R - 1, C) Cells(R, C) = x Next Next End Sub

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

الحمد لله الذى تتم بنعمته الصالحات

السلام عليكم ورحمة الله جرب هذا الكود Private Sub Workbook_Open() cell = WorksheetFunction.Sum(Range("A1:A100")) If cell = 100 Then MsgBox "TRUE" Else MsgBox "FALSE" End If End Sub

السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Private Sub Workbook_Open() For R = 1 To 100 x = Range("A" & R).Address If Range("A" & R) = 1 Then MsgBox "الخلية" & x & "= TRUE" Else MsgBox "الخلية" & x & "=FALSE" End If Next End Sub

السلام عليكم ورحمة الله تم الوصول الى الحل وتأخر الرد بسبب انقطاع الانترنت فى حالة وجود نيجة خطأ فى خلايا المبلغ يرجى الضغط على CRTL + SHIFI + ENTER اليك الملف test1.rar

بارك الله فيك جزاك الله خيرا

السلام عليكم ورحمة الله تفضل اخى الكريم الطلاب.rar