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

السلام عليكم و رحمة الله عذرا على الخطأ اجعل الكود هكذا Private Sub ComboBox1_Change() Dim NameFound As Variant Dim FPath As String FPath = ThisWorkbook.Path & "\" NameFound = ComboBox1.Value FPath = ThisWorkbook.Path & "\" On Error Resume Next Image1.Picture = LoadPicture(FPath & "\" & "Images" & "\" & "NoPict.jpg") Image1.Picture = LoadPicture(FPath & "\" & "Images" & "\" & NameFound & ".jpg") End Sub

السلام عليكم و رحمة الله شاهد هذا المرفق ربما يكون هو طلبك يمكنك التعديل عليه بما يتوافق مع رغباتك ViewPicts.rar

السلام عليكم و رحمة الله استخدم الكود التالى Sub GetData() Dim Sh As Worksheet, ws As Worksheet Dim LR As Long, Countr As Long, p As Long Dim Arr(), Fsl As String, C As Range, j As Long Set Sh = Sheets("saad") Sh.Range("C14:T1000") = "" Fsl = Sh.Range("R12") For Each ws In Worksheets If ws.Name <> Sh.Name Then LR = ws.Range("C" & Rows.Count).End(3).Row Countr = Countr + LR End If Next ReDim Preserve Arr(Countr, 18) For Each ws In Worksheets If ws.Name <> Sh.Name Then For Each C In ws.Range("C10:C" & LR) If C.Offset(0, 15).Value = Fsl Then p = p + 1 For j = 0 To 17 Arr(p - 1, j) = C.Offset(0, j) Arr(p - 1, 0) = p Next End If Next End If Next If p > 0 Then Sh.Range("C14").Resize(p, UBound(Arr, 2)).Value = Arr End Sub

السلام عليكم و رحمة الله استخدم المعادلة التالية بدلا من المعادلة الحالية فى عمود الرقم =IFERROR(INDEX('أسماء الطلاب'!$A$2:$E$890;SMALL(IF('أسماء الطلاب'!$E$2:$E$890=$E$9;ROW('أسماء الطلاب'!$E$2:$E$890));ROW(A1))-1;1);"") و فى عمود الاسم غير الرقم 1 الى الرقم 2 المعادلتين معادلات صفيف اى يجب الضغط على CTRL + SHIFY + ENTER لكى تعمل معك المعادلة

السلام عليكم و رحمة الله هو نفس الكود بدون اى تغيير و لكن يتم و ضعه فى حدث الملف ThisWorkBook هكذا Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False ' اجعل جميع خلايا ورقة العمل الحالية بدون لون Cells.Interior.ColorIndex = 0 With Target ' لون كامل سطر الخلية الفعالة .EntireRow.Interior.ColorIndex = 8 ' لون كامل عمود الخلية الفعالة .EntireColumn.Interior.ColorIndex = 8 End With Application.ScreenUpdating = True End Sub

السلام عليكم و رحمة الله ربما تفيدك هذه المعادلة =IFERROR(DATEDIF(NOW();DATE(VALUE(1960+MID($B2;2;2));VALUE(MID($B2;4;2));VALUE(MID($B2;6;2)));"m");"على المعاش")

السلام عليكم و رحمة الله اليك الملف - المعادلة فى الخلية G2 معادلة اخر رقم فى عمود.xlsx

السلام عليكم و رحمة الله استخدم المعادلة التالية =LOOKUP(2;1/($A$4:$A$23>0);$B$4:$B$23)

السلام عليكم و رحمة الله استخدم المعادلة التالية =IF(COUNTIFS($B$2:$B$220;B2;$C$2:$C$220;C2)>1;"مكرر";"")

السلام عليكم و رحمة الله ضع هذا فى حدث الفورم و عدل فقط اسم الشيت و عنوان الخلية Private Sub UserForm_Initialize() Me.TextBox1.Value = Format(Sheet1.Range("A1"), ".00%") End Sub

السلام عليكم و رحمة الله اجعل الكود هكذا Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Columns("A"), Target.Cells) Is Nothing Then UserForm1.Show 0 Else Exit Sub End If End Sub

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

السلام عليكم و رحمة الله اكتب هذا فى حدث الفورم Private Sub UserForm_Initialize() Me.TextBox1 = Format(Date, "yyyy/mm/dd") End Sub

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

السلام عليكم و رحمة الله و كل عام و انتم بخير المعادلة التالية توضع فى الخلية G6 ثم نضغط CTRL+SHIF+ENTER لانها معادلة صفيف و بعدها نسحب طولا و عرضا ليوم الاثنين فقط =IFERROR(INDEX('جدول توزيع الحصص'!$B$7:$H$12;MATCH(($C9&$G$6&G$7);'جدول توزيع الحصص'!$B$7:$B$12&'جدول توزيع الحصص'!$C$7:$C$12&'جدول توزيع الحصص'!$G$7:$G$12;0);3);"") اما بقى الايام نقوم بتغيير الخلية G6 فى المعادلة ذاتها الى P6 ليوم الثلاثاء و Y6 ليوم الاربعاء و AH6 ليو م الخميس و AQ6 ليوم السبت هذا و الله ولى التوفيق

السلام عليكم و رحمة الله تم تبديل الاعمدة لتتوافق مع طلبك =IF(COUNTIFS($B$3:$B$22;F3;$C$3:$C$22;G3)>0;"مطابق";"غير مطابق")

السلام عليكم ورحمة الله استخدم هذه المعادلة =IF(COUNTIFS($F$3:$F$22;B3;$G$3:$G$22;C3)>0;"مطابق";"غير مطابق")

السلام عليكم و رحمة الله جرب هذا الكود Sub AbsData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long, j As Long Dim C As Range, Name As String, dat Set ws = Sheets("Sheet2") Set Sh = Sheets("Sheet3") LR = Sh.Range("C" & Rows.Count).End(3).Row i = 8 Do While i <= LR Name = Sh.Range("C" & i) For Each C In ws.Range("C2:C20") j = 4 Do While j <= 34 If C.Value = Name And C.Offset(0, 1) = "غ" _ And C.Offset(0, 2) = Sh.Cells(7, j) Then Sh.Cells(i, j) = "غ" End If j = j + 1 Loop Next i = i + 1 Loop End Sub

السلام عليكم و رحمة الله اخى الكريم قبل نسخ المعادلات التالية يجب عليك انشاء نطاق فى اى مكان يعجبك تكتب فيه اسماء الشيتات بصورة مطابقة تماما ثم تقوم بتحديد النطاق و تسميته MonNames يرجى تحويل البيفوت تيبل الى جدول عادى فى الورقة TOTAL و فى الخلية D3 اكتب المعادلة التالية ثم اسحب نزولا =SUMPRODUCT(SUMIF(INDIRECT("'"&MonNames&"'!B2:B101");B3;INDIRECT("'"&MonNames&"'!C2:C101"))) و فى الخلية E3 اكتب المعادلة التالية =SUMPRODUCT(SUMIF(INDIRECT("'"&MonNames&"'!B2:B101");B3;INDIRECT("'"&MonNames&"'!D2:D101"))) و فى الخلية F3 اكتب العادلة الاخيرة =SUMPRODUCT(SUMIF(INDIRECT("'"&MonNames&"'!B2:B101");B3;INDIRECT("'"&$H$2:$H$13&"'!E2:E101"))) هذا و الله اعلى و اعلم

السلام عليكم ور حمة الله اكتب المعادلة التالية فى الخلية D4 ثم اسحب نزولا =DATEDIF($A4;$B4;"y") اما المعادلة التالية اكتبها فى الخلية E4 ثم اسحب نزولا =DATEDIF($A4;$B4;"ym") اما المعادلة الاخيرة اكتبها فى اى خلية تشاء =SUM(D4:D7;INT(SUM($E$4:$E$6)/12))&" Years,"& MOD(SUM($E$4:$E$6);12)&" Months,"

السلام عليكم و رحمة الله استخدم هذا الكود Sub TranData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Integer, Arr Set ws = Sheets("استلام مبلغ") Set Sh = Sheets("جمع المبالغ") ActiveWindow.SelectedSheets.PrintOut from:=1, to:=1, copies:=1 LR = Sh.Range("C" & Rows.Count).End(3).Row Arr = Array("B7", "B6", "E4", "D6", "A8") For i = LBound(Arr) To UBound(Arr) Sh.Range("B" & LR + 1).Offset(0, i) = ws.Range(Arr(i)) Next End Sub

السلام عليكم و رحمة الله هذه الجزئية فى الكود السابق من شأنها مسح البيانات السابقة قبل ترحيل الفصل المطلوب ws.Range("C9:H100")="" اعد نسخ الكود مرة اخرى و سوف تراها

السلام عليكم و رحمة الله استخدم هذا الكود Sub ColData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long Dim Arr As Variant, C As Range Dim p As Long, FSL As String Set ws = Sheets("مجمع") ws.Range("C9:H100")="" FSL = ws.Range("S4") 1 '----------------- On Error Resume Next For Each Sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3")) LR = Sh.Range("O" & Rows.Count).End(3).Row i = i + LR Next 2 '----------------- ReDim Arr(i, 6) p = 0 For Each Sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3")) For Each C In Sh.Range("O10:O" & LR) If C.Value = FSL Then Arr(p, 0) = p + 1 Arr(p, 1) = C.Offset(0, -10).Value Arr(p, 2) = C.Offset(0, -6).Value Arr(p, 3) = C.Offset(0, -4).Value Arr(p, 4) = C.Value Arr(p, 5) = C.Offset(0, 1).Value p = p + 1 End If Next Next 3 '----------------- If p > 0 Then ws.Range("C9").Resize(p, 6).Value = Arr 4 '----------------- End Sub

السلام عليكم و رحمة الله استخدم الكود التالى Sub GetInv() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, CuName As String Dim Date1 As Date, Date2 As Date Dim i As Long, p As Long Set ws = Sheets("فاتورة تاريخ") CuName = ws.Range("C1").Text If CuName = Empty Then Exit Sub Set Sh = Sheets(CuName) Date1 = ws.Range("C2") Date2 = ws.Range("C3") ws.Range("A10").CurrentRegion.Offset(1, 0).ClearContents LR = Sh.Range("M" & Rows.Count).End(3).Row p = 9 i = 10 Do While i <= LR If Sh.Cells(i, 13) >= Date1 And Sh.Cells(i, 13) <= Date2 Then p = p + 1 Sh.Cells(i, 1).Resize(, 13).Copy ws.Range("A" & p).PasteSpecial xlPasteValues ws.Range("A" & p) = p - 9 End If i = i + 1 Loop Application.CutCopyMode = False End Sub

السلام عليكم و رحمة الله اجعل المعادلة هكذا =IF(AND(COUNTIF($AH$1:$AH$7;$H8)>0;COUNTIF($AH$1:$AH$7;$J8)>0);3;IF(COUNTIF($AH$1:$AH$7;J8)>0;2;IF(COUNTIF($AH$1:$AH$7;H8)>0;1;"")))