طارق محمود

السلام عليكم أخي العزيز إن كنت تريد حساب التأخير مقربا لأقرب ساعة مثلا ضع في العمود I - الخلية I2 المعادلة التالية =ROUNDUP(G2*24,0) ثم لإحتساب الغرامة ، وقد فهمت أنها بعد 12 ساعة تكون 8 دينار ، ضع في العمود J - الخلية J2 المعادلة التالية =IF(I2>12,I2*8,I2*7) وانسخهما للأسفل

بارك الله فيك أخي دغديدي فعلا ، عندك حق الكود الذي قدمته أدق جزاك الله خيرا

السلام عليكم أهلا وسهلا بك أخي أبو أنس في أي وقت ....<<<< رددت علي إميلك >>>>> ....

السلام عليكم أخي الكريم أنظر الفيديو المرفق علي أوفيس 2010 ولن يكون الفارق كبير بينه وبين 2003 / 2007 Import emails.rar

السلام عليكم أخي الكريم تفضل المرفق تقرير الاصناف الراكدة2.rar

أخي الحبيب / أبو أنس ملاحظة فقط أنا جعلت النتيجة في العمود M وإن شئت بدله كما تشاء من الأسطر الأخيرة من الكود Next i Cells(i, "M").Value = Raseed 10 Next r Range("M6:M" & [M10000].End(xlUp).Row).NumberFormat = "[Blue]+#,##0.00_ ;[Red]#,##0.00-" End Sub وبالتحديد في المواضع التالية (الحمراء) Next i Cells(i, "M").Value = Raseed 10 Next r Range("M6:M" & [M10000].End(xlUp).Row).NumberFormat = "[blue]+#,##0.00_ ;[Red]#,##0.00-" End Sub

السلام عليكم أخي الحبيب / أبو أنس مشاركاتاك علي العين والراس فقط مشاركة كشف الحساب لم أستطع العمل عليها أو أنها تحتاج توضيح أكثر أعذر إخوانك فلكل ، مشغولياته المهم هذا الطلب سهل والحمد لله تفضل المرفق ، إن شاء الله يعجبك إستخلاص الرصيد لكل مورد2.rar

السلام عليكم أخي الكريم تفضل المرفق غرامة تأخير.rar

السلام عليكم تفضل أخي الكود التالي Sub deleteShapes() ActiveSheet.Shapes.SelectAll Selection.Delete End Sub أو هذا Sub deleteShapes2() For i = ActiveSheet.Shapes.Count To 1 Step -1 ActiveSheet.Shapes(i).Delete Next i End Sub

السلام عليكم أخي العزيز أعذرني في التأخير ، فأنا ضعيف بالفورم كما أوضحت تفضل المرفق به تعديل للفورم الأول وكذلك به أيضا فورم جديد لإسترجاع الحوالات في ورقة Recup راجع وإن كان مازال يلزمك شيء ، كلنا معك حوالة الدفع بالفورم_معدلة2.rar

السلام عليكم أخي الغالي / بن عليه أخي الغالي / عبد الله أشكركم كل الشكر أخي العزيز/ فضل ، جزاك الله خيرا وفضلك الله في الحقيقة أنا إقتبست نفس فكرة أستاذنا بن عليه بس عملتها بالكود مرفق الملف مع بعض الشرح استخراج المكرر لكل اسمين معا مع الشرح.rar

السلام عليكم أخي فضل أرجو تبديل الرقم 2 بالرقم 3 في الجزء الأخير من الكود r = r + 2 تستبدل إلي r = r + 3 في السطر الحادي عشر من الأسفل ليكون الكود كالتالي Sub repeated() With Application: .Calculation = xlCalculationManual: .ScreenUpdating = False: End With Dim L(99), nam(9, 99) As Variant i = 1 L(i) = Cells(2, "B") ' تصفية اللجان For r = 3 To [B10000].End(xlUp).Row For c = 1 To i If Cells(r, "B") = L(c) Then GoTo 10 Next c i = i + 1 L(i) = Cells(r, "B") 10 Next r L_Count = i ' عدد اللجان For exam = 1 To 5 s_r = (exam - 1) * 42 + 2 'Start Row e_r = s_r + 41 'End Row For r = s_r To e_r Step 2 For i = 1 To L_Count If Cells(r, "B") = L(i) Then j = i: GoTo 20 Next i 20 nam(exam, j) = "(" & Cells(r, "A") & ") + (" & Cells(r + 1, "A") & ")" Next r Next exam ' Compare r = 1 For exam = 1 To 4 For i = 1 To L_Count - 1 For j = exam + 1 To 5 For n_i = 1 To L_Count If IsEmpty(nam(exam, i)) Or IsEmpty(nam(j, n_i)) Then GoTo 30 If nam(exam, i) = nam(j, n_i) Then r = r + 3 Cells(r, "E") = L(i) & " بالإمتحان " & exam: Cells(r, "D") = nam(exam, i) Cells(r + 1, "E") = L(n_i) & " بالإمتحان " & j: Cells(r + 1, "D") = nam(j, n_i) End If 30 Next n_i Next j Next i Next exam With Application: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True: End With End Sub

السلام عليكم أخي فضل بعد إذن أستاذنا العظيم بن عليه (بارك الله فيه وجزاه خيرا) تفضل المرفق بالأكواد استخراج المكرر لكل اسمين معا.rar

السلام عليكم أخي الحبيب / معتصم تحياتي رأيك في المسألة أقرب للصواب جزاك الله خيرا

السلام عليكم أخي العزيز تفضل المرفق مورديين3.rar

السلام عليكم أخي / أبا أحمد إيه الأكواد الشديدة والمختصرة دي ماشاء الله ربنا يزيدك

السلام عليكم أخي العزيز ضع الكود التالي في حدث الورقة (PART 1) Private Sub Worksheet_Change(ByVal Target As Range) Dim x As String, v As Variant, r, j, T_R As Integer, myRange As Range x = Target.Address If x <> "$H$2" And x <> "$H$22" And x <> "$H$42" Then Exit Sub v = Target.Value T_R = Target.Row On Error Resume Next With Sheets("1") Set myRange = .Range("B8:B" & .[B10000].End(xlUp Private Sub Worksheet_Change(ByVal Target As Range) Dim x As String, v As Variant, r, j, T_R As Integer, myRange As Range x = Target.Address If x <> "$H$2" And x <> "$H$22" And x <> "$H$42" Then Exit Sub v = Target.Value T_R = Target.Row On Error Resume Next With Sheets("1") Set myRange = .Range("B8:B" & .[B10000].End(xlUp).Row) End With r = WorksheetFunction.Match(v, myRange, 0) If r < 1 Then For j = 5 To 11 Step 2 Range("E" & j + T_R & ":G" & j + T_R).ClearContents Next j Range("E" & 5 + T_R & ":G" & 11 + T_R).Interior.ColorIndex = 3 MsgBox ("لايوجد هذا الرقم الوظيفى في الورقة 1") Range("E" & 5 + T_R & ":G" & 11 + T_R).Interior.ColorIndex = xlNone Exit Sub Else Cells(5 + T_R, "E") = Sheets("1").Cells(7 + r, 4) Cells(7 + T_R, "E") = Sheets("1").Cells(7 + r, 5) Cells(9 + T_R, "E") = Sheets("1").Cells(7 + r, 9) Cells(11 + T_R, "E") = Sheets("1").Cells(7 + r, 7) End If End Sub أو تفضل المرفق مهم2.rar

السلام عليكم تم عمل الترحيل الأوتوماتيكي للبيانات بالشروط التالية 1- يتم نقل بيان واحد فقط الذي تم إضافته أخيرا 2- إذا كانت البيانات ضمن الجدول 1 أو 2 (نفس الأعمدة) 3- البيانات القديمة لن يرحلها ، يمكنك إستخدام السهم الأصفر (في الأول فقط) ، تركته لك لهذا الغرض 4- البيانات التامة الكاملة ( بيان + مدين أو بيان + دائن )فقط هي التي يتم ترحيلها ___ أي أنك إن كتبت مثلا في العمود L ولم تتم في عموده المجاور فلن ينتقل البيان إلا إذا كانت الخليتين غير فارغتين 5- منعت تغيير البيانات القديمة ن لو وقفت علي إدي الخليتين في أي من الجدول 1 أو 2 في منطقة البيانات القديمة سينتقل المؤشر اوتوماتيك لآخر خلية في نفس العمود تفضل المرفق book12_3.rar

السالام عليكم تفضل أخي المرفق وبه الكود المطلوب book12_2.rar

السلام عليكم أسهل طريق إبدأ بالتطبيق علي ملفك هذا وكلنا معك

إخواني الأعزاء والأفاضل الزير أبوتميم جودة حسين رجب أشكركم جزيلا مروركم شرف عظيم ، جزاكم الله خيرا

السلام عليكم أخي العزيز / الشهابي السؤال ماشاء الله ، ذكي ويدل علي تدقيق وتمحيص فعلا أنا سألت نفسي هذا السؤال من قبل ولم أجد إجابة فوضعت في ذهني إجابة افتراضية ،غير متأكد منها، وهي أنه المدي الديناميكي قد يمتد لخارج الملف بمعني أن تسمي مجالا في ملف آخر معتمدا علي بعض بيانات الملف الحالي والله أعلم

السلام عليكم الحمد لله ، تمام كده هذا أكيد من سرعة النت المفروض أن الملف أصبح أسرع بعدة مرات ملاحظة لعمل جميع العمليات مرة واحدة بما فيها إضافة العمودين Q و R في All_Market أضف سطر قبل نهاية الكود الأصلي (Update_All_Market) السطر المضاف هو Call Add_Symbol ليصبح الكود الأصلي (Update_All_Market) كالتلي .. .. .. Next k End With 20 Next i [M:M].NumberFormat = "yyyy/mm/dd;@" [A2].Select Call Add_Symbol End Sub

السلام عليكم أخي العزيز المعادلات كثيرة جدا لو تحولها لأكواد سيقل الحجم والوقت كثيرا

السلام عليكم أخي العزيز تأخرت عليك لانشغالي ولأن المطلوب كان كثيرا تم تنفيذ كل ماأردته علي الملف أصبح سريع جدا (بعد تحديث البيانات - طبعا) وأصبح حجمه قليل نسبيا تفضل المرفق Arab_Market2.rar