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

السلام عليكم ورحمة الله اكتب هذه المعادلة =A5*1.2^7)

السلام عليكم ورحمة الله اخى الكريم عذرا لم اكن اتوقع نقل المعادلة من خلية الى اخرى اليك الملف مرة اخرى استعلام1.rar

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

السلام عليكم ورحمة الله اكتب المعادلة التالية فى الخلية A3 ثم اسحب نزولا =SUBTOTAL(3;$E$2:E2)

السلام عليكم ورحمة الله اكتب المعادلة الاولى فى الخلية J4 والمعادلة الثانية فى الخلية L4 و لا تنسى ازالة دمج هذه الخلايا لان معادلات الصفيف لا يمكن تمكينها فى الخلايا المدمجة كما يجب الضغط Crtl + Alt + Shift =VLOOKUP(MIN(IF($C$16:$C$144>=$J$3;$C$16:$C$144;""));$C$16:$H$144;6;0) =VLOOKUP(MAX(IF($C$16:$C$144<=L3;$C$16:$C$144;""));$C$16:$H$144;6;0)

السلام عليكم ورحمة الله اليك الملف بنفس الكود فى المشاركة الثانية عملاء وأرصده - 3.rar

السلام عليكم ورحمة الله كرر عملية الاستبدال بهذا الكود Private Sub CommandButton7_Click() Me.ComboBox1.Value = "" Dim ws As Worksheet, x As Integer, C As Range Set ws = Worksheets("ss") x = WorksheetFunction.CountIf(ws.Range("A101:A1000"), CDate(Me.TextBox2.Value)) If x > 0 Then MsgBox "هذا التاريخ سبقا ادراجه من قبل" Exit Sub End If For Each C In ws.Range("A101:A1000") If CDate(Me.TextBox2.Value) < C.Value Then MsgBox "هذا التاريخ اصغر من كل التواريخ المدرجة مسبقا" Exit Sub End If Next iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row ws.Cells(iRow, 1).Value = CDate(Me.TextBox2.Value) ws.Cells(iRow, 2).Value = Me.TextBox3.Value ws.Cells(iRow, 3).Value = Me.TextBox4.Value ws.Cells(iRow, 4).Value = Me.TextBox5.Value ws.Cells(iRow, 6).Value = Me.TextBox6.Value ws.Cells(iRow, 7).Value = Me.TextBox7.Value If CheckBox1.Value = True Then ws.Cells(iRow, 5).Value = True If CheckBox1.Value = False Then ws.Cells(iRow, 5).Value = False End Sub

السلام عليكم ورحمة الله استبدل كود الترحيل بهذا الكود Private Sub CommandButton7_Click() Me.ComboBox1.Value = "" Dim ws As Worksheet, x As Integer Set ws = Worksheets("ss") x = WorksheetFunction.CountIf(ws.Range("A101:A1000"), CDate(Me.TextBox2.Value)) If x > 0 Then MsgBox "هذا التاريخ سبقا ادراجه من قبل" Exit Sub End If iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row ws.Cells(iRow, 1).Value = CDate(Me.TextBox2.Value) ws.Cells(iRow, 2).Value = Me.TextBox3.Value ws.Cells(iRow, 3).Value = Me.TextBox4.Value ws.Cells(iRow, 4).Value = Me.TextBox5.Value ws.Cells(iRow, 6).Value = Me.TextBox6.Value ws.Cells(iRow, 7).Value = Me.TextBox7.Value If CheckBox1.Value = True Then ws.Cells(iRow, 5).Value = True If CheckBox1.Value = False Then ws.Cells(iRow, 5).Value = False End Sub

السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Sub حفظ() Application.ScreenUpdating = False Dim Lr As Integer, C As Range Lr = [A10000].End(xlUp).Row For Each C In Range("D3:D" & Lr) If C.Value = "" Then MsgBox "يوجد بعض البيانات الناقصة بعمود العدد" Exit Sub End If Next Range("A3:i" & Lr).Copy Sheets("مخزن").Range("A" & Sheets("مخزن").[A10000].End(xlUp).Row + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False MsgBox "تم الحفظ بنجاح", vbOKOnly, "تنبية" Range("A3:e10000").ClearContents End Sub

السلام عليكم ورحمة الله انسخ الكودين التاليين والصقهما فى موديول وخصص لكل منهما زر الاول للاخفاء والثانى للاظهار Sub HideColumn() lr = Sheet2.Range("A" & Rows.Count).End(xlUp).Row a = WorksheetFunction.CountA(Sheet2.Range("A1:A" & lr)) b = WorksheetFunction.CountBlank(Sheet2.Range("A1:A" & lr)) c = a - b + 1 d = a - 1 Rows(c & ":" & d).EntireRow.Hidden = True End Sub Sub UnHideColumns() lr = Sheet2.Range("A" & Rows.Count).End(xlUp).Row a = WorksheetFunction.CountA(Sheet2.Range("A1:A" & lr)) b = WorksheetFunction.CountBlank(Sheet2.Range("A1:A" & lr)) c = a - b + 1 d = a - 1 Rows(c & ":" & d).EntireRow.Hidden = False End Sub

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

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

السلام عليكم ورحمة الله اخى الكريم اكثر من يومين وانا احاول ان اصل الى حل لموضوعك حتى توصلت الى الحل السابق وقد تم تعديل الكود حتى لا تمسح البيانات اثناء عملية البحث البحث عن طريق اسم الحساب لا توجد فيه اى مشكلة وهو المحدد بالكود التالى اما البحث باسم العميل فقد وجدت ان كل عميل مجموع ارصدته المدينة يساوى مجموع ارصدته الدائنة و بناءا على هذا الشرط لن تظهر اى بيانات اثناء البحث انك تشترط عدم تساوى المجموعين و الان اليك الكود بعد التعديل Sub Collect2() ' جلب بيانات ارصدة العملاء المدينة والدائنة شريطة عدم تساويهما Dim Arr As Variant, temp As Variant Dim ws As Worksheet, sh As Worksheet, C As Range Dim xx As String, y As Long, z As Long, LR As Long, i As Long, p As Long Set ws = Sheets("الحركة") Set sh = Sheets("استعلام") p = 7 xx = sh.Range("E5") LR = ws.Range("K" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False sh.Range("C8:E" & sh.Range("C" & Rows.Count).End(xlUp).Row + 7).ClearContents For Each C In ws.Range("K2:K" & LR) If C.Value = xx Then p = p + 1 sh.Cells(p, "C") = C.Offset(0, -1) sh.Cells(p, "D") = C.Offset(0, -3) sh.Cells(p, "E") = C.Offset(0, -5) End If Next Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله استخدم هذا الكود وخصص له زر Sub Results() Dim i As Long, p As Long Dim x As Integer, z As Integer For i = 6 To Sheet1.Range("C" & Rows.Count).End(xlUp).Row p = 0 For j = 4 To 10 If Cells(i, j) < Cells(5, j) Then p = p + 1 End If If Cells(i, 11) < Cells(5, 11) Then x = 1 Else x = 0 End If If p = 0 And x = 0 Then Cells(i, 12) = "ناجح" ElseIf p <= 2 And x = 0 Then Cells(i, 12) = "دور ثانى" ElseIf p <= 2 And x = 1 Then Cells(i, 12) = "دور ثانى" ElseIf p > 2 Then Cells(i, 12) = "راسب" End If Next Next End Sub

السلام عليكم ورحمة الله احفظ الملف بصيغة 2003 او اعلى حتى يتم تنفيذ الكود او قم بارسال الملف نفسه ويجب ان تتأكد ايضا من رقم الشيت فى الملف الاصلى يتوافق مع رقم الشيت كما فى الكود عموما يوجد خطأ فى الكود السابق وقد تم اصلاحه لذا يرجى استبداله بهذا الكود Sub TransDataArray() Dim Arr As Variant, Temp As Variant, Temp2 As Variant Dim i As Long, j As Long, p As Long Arr = Sheet1.Range("C2:E" & Sheet1.Range("D" & Rows.Count).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 3) = "متزوج" Then p = p + 1 For j = 1 To UBound(Arr, 2) Temp(p, j) = Arr(i, j) Next End If Next Sheet1.Range("G2").Resize(p, UBound(Temp, 2)).Value = Temp For ii = 1 To UBound(Arr, 1) If Arr(ii, 3) = "اعزب" Then q = q + 1 For j = 1 To UBound(Arr, 2) Temp(q, j) = Arr(ii, j) Next End If Next Sheet1.Range("K2").Resize(q, UBound(Temp, 2)).Value = Temp End Sub

السلام عليكم ورحمة الله انسخ هذا الكود والصقه فى موديول وخصص له زر Sub TransDataArray() Dim Arr As Variant, Temp As Variant Dim i As Long, j As Long, p As Long Arr = Sheet1.Range("C2:E" & Sheet1.Range("D" & Rows.Count).End(xlUp).Row).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 3) = "متزوج" Then p = p + 1 For j = 1 To UBound(Arr, 2) Temp(p, j) = Arr(i, j) Next End If If Arr(i, 3) = "اعزب" Then q = q + 1 For j = 1 To UBound(Arr, 2) Temp(q, j) = Arr(i, j) Next End If Next Sheet1.Range("G2").Resize(p, UBound(Temp, 2)).Value = Temp Sheet1.Range("K2").Resize(q, UBound(Temp, 2)).Value = Temp End Sub

السلام عليكم ورحمة الله اكتب المعادلة التالية فى الخلية G2 ثم اسحب نزولا =IF(ISERROR(MATCH(B2;ورقة3!$A$1:$A$117;0));"غير موجود ";" موجود")

السلام عليكم ورحمة الله كل عام وانتم بخير ربما يعجبك هذا الشئ الخلاصة.rar

السلام عليكم ورحمة الله كل عام وانتم بخير اخى الخزيز موضوعك ليس سهلا و هذا اقصى ماتوصلت اليه انسخ هذا الكود و الصقه فى موديول جديد وخصص له زر فى ورقة الاستعلام Sub Collect3() ' جلب بيانات ارصدة العملاء المدينة والدائنة شريطة عدم تساويهما Dim Arr As Variant, temp As Variant Dim ws As Worksheet, sh As Worksheet, C As Range Dim xx As String, y As Long, z As Long, LR As Long, i As Long, p As Long Set ws = Sheets("الحركة") Set sh = Sheets("استعلام") p = 7 xx = sh.Range("E5") LR = ws.Range("K" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False sh.Range("C8:E" & sh.Range("C" & Rows.Count).End(xlUp).Row).ClearContents For Each C In ws.Range("K12:K" & LR) x = WorksheetFunction.CountIf(Range(ws.Cells(12, "K"), C), C) If x = 1 Then y = WorksheetFunction.SumIfs(ws.Range("F12:F" & LR), ws.Range("G12:G" & LR), xx, ws.Range("K12:K" & LR), C) z = WorksheetFunction.SumIfs(ws.Range("H12:H" & LR), ws.Range("I12:I" & LR), xx, ws.Range("K12:K" & LR), C) If y <> z Then p = p + 1 sh.Cells(p, "C") = C.Value sh.Cells(p, "D") = y sh.Cells(p, "E") = z End If End If Next Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله ربما هذا يفيدك Lists.rar

السلام عليكم ورحمة الله كل عام و انتم بخير تفضل اخى الكريم Work Sheet - Cairo Branch - Copy.rar

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية D4 =IF(C4="";"";$D$1-SUM($C$4:C4)) ثم اسحب نزولا

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

السلام عليكم ورحمة الله اخى الكريم استخدم هذه المعادلة على اعتبار ان اسم العميل فى الخلية D3 =SUMIF($E$16:$E$380;$D$3;G16:P380)

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