AbuuAhmed

محاولتي: التنسيق الشرطي_01.xlsx

في المشاركة التالية تم اختيارها أفضل إجابة وبقدرة قادر حذفت الأفضلية 🙂

تم تصحيح هفوة صغيرة مستجدة. وتم إضافة مجموع القيمة ومتوسط السعر ومجموع السجلات. بعض النتائج لن تظهر كمتوسط السعر لأن بيانات الفاتورة غير مكتملة. مرفق الملف مرة أخرى. تحويل الفاتورة إلى مصفوفة_03.xlsb

جرب المرفق اضطررت لعمل صفحة خاصة باسم "مصفوفة" تم حذف المرفق لوجود هفوة في هذين السطرين: tRow = 2 For row1 = 2 To lRow

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

السلام عليكم للأسف هذه معلومة جديدة لي وهي سيئة جدا، وهذا عيب من عيوب الموقع. الآن تفهمت بعض الممارسات الخاطئة ومنها هذا الخيار، أساسا خيار "أفضل إجابة" يساء استخدامه من كثير من أعضاء المنتدى، وإعطاء هذه الخيار للمشرفين أكثر سوءًا. ولا تحدثنا أستاذ محمد عن تقوى المشرفين وفريق العمل وتحدثنا عن أخلاقهم العالية وتعاملهم الذي يضرب به الأمثال، فهم أناس مثلهم مثل باقي الأعضاء لهم ما لهم وعليهم ما عليهم، فمنهم من تحدث بينه وبين الأعضاء احتكاكات ومصادمات وتنافر تحيدهم عن الجادة والإنصاف والسلوك المسئول وربما يقومون بأخطاء مقصودة وموجهة أيضا. في هذا الموضوع: أفضل إجابة واضحة وضوح الشمس في عز الظهر لا تحتاج إلى جهد ولا إلى تفكير ولا إلى محكمين متمرسين ومع أني لست بحاجة لها ولكنها بكل بساطة سرقت مني وقدمت كهدية لغيري 🙂 وهذا به استفزاز كبير. شيء سيئ للغاية، وقد كنت أعتقد أن السائل هو من قام بالاختيار ولكن بعد حذف تعليقي والذي لا يحتوي على إهانات ولا استنقاص من أحد ولا لغة رديئة ومن ثم غلق الموضوع وبعد قراءتي لهذا الموضوع عرف السبب وبطل العجب. لما الخوف من إبداء الآراء وتقديم الملاحظات والانتقادات، هذا وإن أعضبتك مشاركتي فهذا سلوك غير الواثق والخائف. تحياتي.

جرب هذا الكود: بعد تشغيله أول مرة خذ لك نظرة على الفاتورة، ثم شغله مرة ثانية للتخلص من السطور الفارغة. Option Explicit Sub Macro1() Dim row1 As Integer, row2 As Integer, col As Integer Dim lRow As Integer, tRow As Integer On Error Resume Next Sheets("الفواتير").Select lRow = Range("A1").SpecialCells(xlLastCell).row Range("A2:I" & lRow).Select ActiveWorkbook.Worksheets("الفواتير").ListObjects("الفواتير").Sort.SortFields. _ Clear ActiveWorkbook.Worksheets("الفواتير").ListObjects("الفواتير").Sort.SortFields. _ Add Key:=Range("الفواتير[رقم الفاتورة]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal ActiveWorkbook.Worksheets("الفواتير").ListObjects("الفواتير").Sort.SortFields. _ Add Key:=Range("الفواتير[الصنف]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("الفواتير").ListObjects("الفواتير").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With tRow = 3 For row1 = 3 To lRow If Cells(row1, 4) <> "" Then tRow = row1 For row2 = row1 + 1 To lRow If Cells(row2, 4) = Cells(tRow, 4) And _ Cells(row2, 8) = Cells(tRow, 8) Then Cells(tRow, 5) = Cells(tRow, 5) + Cells(row2, 5) For col = 1 To 9 Cells(row2, col) = "" Next col Else Exit For End If Next row2 End If Next row1 Range("A3").Select MsgBox "Done" End Sub تم إضافة هذا السطر: On Error Resume Next تم التعديل في هذ السطر: For row1 = 3 To lRow وإضافة هذين السطرين أيضا: Else Exit For

جرب محاولتي: تقريب الدينار العراقي_01.xlsx

شكرا لكم. تنقيح أخير للكود: Option Explicit Function CountPeople(ByVal ID As String) As Integer Dim People() As String, Item As String Dim Items As Integer, Pos As Integer Dim i As Integer, Count As Integer ID = Replace(ID, " ", "", 1, -1) If ID = "" Then Exit Function People = Split(ID & "+", "+") Items = UBound(People()) - 1 For i = 0 To Items Item = People(i) Select Case Item Case "INF": 'Count = Count + 0 Case "SGL": Count = Count + 1 Case "DBL": Count = Count + 2 Case "TRP": Count = Count + 3 Case Else Pos = InStr(1, Item, "CH(") If Pos > 0 Then If Pos = 1 Then Count = Count + 1 Else Count = Count + Val(Left(Item, Pos - 1)) End If End If End Select Next i CountPeople = Count End Function

محاولتي: استخراج أعداد الغرف_01.xlsm

أتمنى ترجع لنا بصحة النتائج من عدمها، وهذا ينفعنا جميعا عند عرض السؤال مرة أخرى من أعضاء آخرين أن نقدم لهم الحل الصحيح، بهذه الطريقة لا نعرف هل ما عملناه صحيحا أم يحتاج إلى تصحيح. لا تخجل أخي من المراجعة والتقييم للحلول، فهذه الأمور لا مجاملات فيها. موفقين.

بعد تنقيح الكود سن المعاش في مصر_02.xlsm

تم إصلاح الخلل وعمل عدة تنقيحات: حضور وإنصراف_05.xlsb

محاولة منى، مع وجود طريقة أخرى باستخدام حماية الخلايا ولكنها تحتاج عناية كبيرة، هذه أعتقد تفي بالغرض. ظهر لي خلل فجأة ثم حاولت في حدوثه مرة أخرى لمعرفة السبب وحل المشكلة ولكنه اختفى!!. حضور وإنصراف_04.xlsb

إذن في حالة الغياب ستبدل "P" بحرف "A" مثلا؟ اقتراحي لا داعي لكتابة "P" للحضور، ولا "V" لعطلة نهاية الأسبوع. أنت تحتاج فقط: كتابة "A" من Absent في حالة الغياب فقط. وكتابة "V" من Vacation في حالة كونه في إجازة. أما عطلة نهاية الأسبوع لا تحتاج إلى كتابة، وعند الرغبة فليكن حرفها "W" من Weekend. ويمكن التحكم عند الكتابة بمنع الإدخال في خانة عطلة نهاية الأسبوع كذلك ومنع إدخال غير الحروف المطلوبة. سؤال آخل ماذا لو عمل الموظف أيام العطل الأسبوعية، هل ستضع له حرفا جديدا أم ستستخدم حرف "P" أيضا؟

أعرف سؤالي قد يكون تطفلا، وما دفعني للسؤال لغرابة الطلب، أنا توقعت ستملأ الخلايا ببيانات متغيرة وليست ثابتة كـ "V" و "P". ربما لو توضح لنا الهدف اختصرنا لك كل هالتصميم والكود بدالة صغيرة من خمسة سطور تعطيك المعلومة المطلوبة بسهولة.

آسف ما كنت مركز على المطلوب تماما، كان تركيزي منصب على التنسيق الشرطي 🙂 حضور وإنصراف_03.xlsb

استخدم زر "التنسيق الشرطي" في صفحة "Support" حضور وإنصراف_02.xlsb

الكود: Sheets("Base").Select Range("D7:AH15").Select Selection.FormatConditions.Delete Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=WEEKDAY(D$6)=" & vbFriday Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent2 .TintAndShade = 0.399945066682943 End With Selection.FormatConditions(1).StopIfTrue = False MsgBox "Done"

حسب طلبك حضور وإنصراف_01.xlsb

محاولة باستخدام العرض فقط. ما دور الارتفاع في المعادلات؟ أنا عملت محاولتي حسب ما فهمته، في انتظار تعليقلك على المحاولة. لا تشغل نفسك في الشكل وعدد الأعمدة، ركز فقط على الجواب. need help_01.xlsx

للأسف الملف لا يناسب مطلبك، هل يمكنك وضع إجابتين مفترضتين أو ثلاث تنفعنا فب المحاولات والمقارنة؟

ذكرتني بملف عملته لأحد المصانع ولكنه لحساب "الهدر" كما تسميه لكتل أو بلوكات ذات 3 أبعاد، ولا أعرف إذا يتكيف مع طلبك أو لا. سأبحث عنه وإن وجدته صالحا لطلبك سأرسله لك على الخاص لأني لا أعرف هل بعض المعلومات التي به تعتبر من أسرار العمل لدى المصنع أو لا. سأرجع لك ولك قد أتأخر عليك.

جرب تنشئ موديول جديد ثم الصق الدالة به. وإذا تقدر ترفع ملفك يستطيعون الزملاء مساعدتك بشكل سريع.

أضف هذه الدالة إلى الوحدة النمطية (المديول): Sub mySendKeys(String_ As String, Optional Wait As Boolean = False) Dim WshShell As Object Set WshShell = CreateObject("WScript.Shell") WshShell.SendKeys String_, Wait Set WshShell = Nothing End Sub ليصبح الأمر أعلاه كالتالي: mySendKeys "^f", True