كل الانشطه

مرفق الملف شهر 12022.zip

السلام عليكم ورحمة الله وبركاته اخواتي في الله مطلوب كود يقوم بترحيل المكتوب في شيت Main في الخليه C8 الى اسم الشيت المكتوب في الخليه B2 يقوم بترحيلها بالترتيب في العمود B6 ثم يقوم بنسخ شيت NEW وفتح شيت جديد باسم الخليه B2 في شيت Main وان امكن ان يعمل ربط تشعبي اذا امكن تطبيقها على الملف المرفق جعله الله في موازين حسناتكم BB.xlsm

المشكلىة الملف كبير فيه تقريبا 20 الف صف وحجمه كبير هذا صورة من بيانات الملف price الكمية الصنف التاريخ 0.850 70 خيار 01-Jan-22 0.075 42 جرجير 01-Jan-22 0.850 232 خيار 01-Jan-22 0.850 30 خيار 01-Jan-22 1.000 23 باذنجان 01-Jan-22 1.000 13 كزبرة 01-Jan-22

من الأفضل رفع ملف ليتم العمل عليه

تفضل Sub FormatUniqueCellsInRow() Dim ws As Worksheet Dim lastRow As Long, startRow As Long Dim r As Long, i As Long, j As Long Dim values(1 To 7) As Variant Dim count As Long Dim data As Variant On Error GoTo ErrorHandler Set ws = ThisWorkbook.Sheets("Sheet1") ' تأكد من تغيير "Sheet1" إلى اسم الورقة الفعلي startRow = 3 ' الصف الذي تبدأ منه البيانات lastRow = ws.Range("C3:I" & ws.Rows.Count).Find(What:="*", _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' تنظيف التنسيقات السابقة من الأعمدة C:I و O With ws.Range("C" & startRow & ":I" & lastRow & ",O" & startRow & ":O" & lastRow) .Interior.ColorIndex = xlNone .Font.ColorIndex = xlAutomatic .Font.Bold = False End With ' تحميل النطاق إلى مصفوفة data = ws.Range("C" & startRow & ":I" & lastRow).Value ' المرور على كل صف For r = 1 To lastRow - startRow + 1 ' تخزين قيم الصف الحالي For i = 1 To 7 values(i) = data(r, i) Next i ' فحص القيم الفريدة For i = 1 To 7 count = 0 If Not IsEmpty(values(i)) Then For j = 1 To 7 If CStr(values(j)) = CStr(values(i)) Then count = count + 1 End If Next j ' إذا كانت القيمة فريدة If count = 1 Then ' تطبيق التنسيق على الخلية في C:I With ws.Cells(r + startRow - 1, i + 2) .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With ' تطبيق نفس التنسيق على الخلية في العمود O في نفس الصف With ws.Cells(r + startRow - 1, "O") .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء .Font.Color = RGB(255, 0, 0) ' خط أحمر .Font.Bold = True ' خط عريض End With End If End If Next i Next r MsgBox "تمت معالجة البيانات بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical End Sub

لدى جدول مكون من التاريخ والكمية والصنف وسعر العبوة واريد استخراج تقرير لكل شهر لاعلى قيمة لكل صنف حسب الشهر حسب الأشهر 1 2 3 4 5 6 7 8 9 10 11 12 طماطم فلفل حلو خيار خس بروكلى كزبرة ملفوف بقدونس باذنجان لوبيا اشبنت نعناع

تحويل الدالة الى دالة عامة ، يتم استدعائها في أي نموذج ، توسيع الفكرة اختيار التاريخ لا يعمل بشيت b-c-d.xlsm

هذا الكود الصحيح بخصوص تنسيق الاعمدة المختلفة من العمود C حتى العمود I هل يمكن اضافة ودمج كود خاص بتنسيق العمود المحدد فى العمود O Sub FormatUniqueCellsInRow() Dim ws As Worksheet Dim lastRow As Long Dim r As Long Dim values(1 To 7) As Variant ' لتخزين القيم من C إلى I (7 أعمدة) Dim i As Integer, j As Integer Dim count As Integer ' 1. إعدادات ورقة العمل Set ws = ThisWorkbook.Sheets("Sheet1") ' ?? غيّر "Sheet1" إلى اسم ورقتك الفعلي ' 2. تحديد آخر صف يحتوي على بيانات في العمود C lastRow = ws.Cells(ws.Rows.count, "C").End(xlUp).Row ' 3. تنظيف أي تنسيقات سابقة من الأعمدة C إلى I ' هذا مهم لضمان تطبيق التنسيقات الجديدة فقط ws.Range("C3:I" & lastRow).Interior.ColorIndex = xlNone ' مسح لون التعبئة ws.Range("C3:I" & lastRow).Font.ColorIndex = xlAutomatic ' مسح لون الخط المخصص ws.Range("C3:I" & lastRow).Font.Bold = False ' إلغاء الخط العريض ' 4. المرور على كل صف بدءًا من الصف 3 (أو أي صف تبدأ منه بياناتك) For r = 3 To lastRow ' ابدأ من الصف الذي تبدأ منه بياناتك ' قراءة القيم من العمود C إلى I للصف الحالي وتخزينها في مصفوفة ' Column C is index 1 (i + 2 where i=1 means 1+2=3 which is C) For i = 1 To 7 values(i) = ws.Cells(r, i + 2).Value ' i+2 لأن C هو العمود الثالث Next i ' فحص كل قيمة في الصف لتحديد إذا كانت فريدة داخل هذا الصف For i = 1 To 7 ' تكرار على كل عمود من C إلى I (بواسطة فهرس المصفوفة i) count = 0 ' إعادة تعيين العداد لكل قيمة ' مقارنة القيمة الحالية (values(i)) بجميع القيم الأخرى في نفس الصف For j = 1 To 7 If values(j) = values(i) Then count = count + 1 End If Next j ' إذا كانت القيمة فريدة (تكررت مرة واحدة فقط في الصف) If count = 1 Then ' تطبيق التنسيق على الخلية المحددة التي تحتوي على القيمة الفريدة With ws.Cells(r, i + 2) ' i + 2 يمثل رقم العمود الفعلي (C, D, E...) .Interior.Color = RGB(255, 255, 0) ' تعبئة صفراء (RGB for exact yellow) .Font.Color = RGB(255, 0, 0) ' خط أحمر (RGB for exact red) .Font.Bold = True ' خط عريض End With End If Next i Next r ' إذا كنت لا تزال ترغب في الاحتفاظ بالعمود O بالنص الوصفي، يمكنك ترك الكود الخاص بك ' Sub CheckDifferences() وتشغيله بعد هذا الكود، أو دمج المنطق هنا. ' لكن هذا الكود يركز فقط على تنسيق الخلايا من C إلى I. End Sub

قد سبقني السباقون الأساتذة .. ما شاء الله عليهم .. عذراً للتأخر في الرد ، ولكن يبدوا أنهم قد أجادوا بما طرحوا ، ويسعدني نقلك للإجابة لأي حل آخر تراه مناسباً لك ( بصدر رحب طبعاً ) .

معلمي الفاضل ، اعتذر عن التأخر بالرد ، ولكن فعلاً تفاجأة بضيوفي من العائلة 😅 ولوقت متأخر لم أتمكن من المتابعة ,, على العموم ، وبما انك رأيت ان فكرة الحقلين هي الأنسب لك والأوفر والأقل جهداً ، قد يكون قرارك صائباً برؤية أبعد .. على العموم بانتظار مرفقك المعدل ، ومتابع معك .

ممتاز اخواتي الكرام شكرا استاذ حجازي والف شكر استاذي الفاضل محمد هشام جعله الله في موازين حسناتكم

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

شكرا جزيلا اخي وحبيبي .. يبدو ان طلبات اخوك العود متعبة و لن تنتهي بعد عدة محاولات اكتشفت ان رصد التوقيع في حقلين منفصلين افضل بكثير من الحقل الواحد ولم اكن بعيدا عن مناقشتنا في هذا الموضوع للعلم ما تم نقاشه في الموضع المشار اليه تم انجازه وهو يعمل الآن بامتياز الفرق بين الحقل والحقلين : - في تطبيق الحقل الواحد نحن بحاجة الى كثير من الاستعلامات من اجل التمييز فقط بين توقيع الحضور والانصراف .. والأمور الأخرى الخاصة برصد التوقيع بينما في الحقلين استعلام واحد هو المسؤول عن جميع المهام - المخرجات وما ادراك ما المخرجات .. الفرق واضح وكبير جدا بين الطريقتين عند استخلاص النتائج .. بدون ذكر التفاصيل وبدون تعليق فهو معروف لكل مبرمج الآن سوف اعمل على هذه الطريقة وسأوافيكم بمثال .. لأن التنظير لا يكفي لوحده فعند المثال يتحقق المقال ..

بعد إذن أساتذتي حل بالمعادلات بشكل مبسط BB (3).xlsx

للرفع

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا BB.xlsx

اخي الكريم هل من الممكن ان تكون معادله وليس كود ؟ بارك الله لك في علمك ومجهودك وحفظك الله من كل شر

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

وعليكم السلام ورحمة الله وبركاته ,, حاولت فهم المطلوب بشكل واضح ، وخرجت بهذه الفكرة . حيث انشأت زر للتنفيذ ، يحتوي الكود التالي :- Private Sub Btn_1_Click() Dim wsMain As Worksheet Dim wsTarget As Worksheet Dim lastRow As Long Dim i As Long Dim targetCol1 As String, targetCol2 As String Dim sourceCol1 As String, sourceCol2 As String Set wsMain = ThisWorkbook.Sheets("F") Dim targetSheetName As String targetSheetName = wsMain.Range("F6").Value On Error Resume Next Set wsTarget = ThisWorkbook.Sheets(targetSheetName) On Error GoTo 0 If wsTarget Is Nothing Then MsgBox " : الورقة المحددة غير موجودة" & targetSheetName, vbExclamation + vbMsgBoxRight, "" Exit Sub End If If wsMain.Range("G6").Value = "قوى" Then sourceCol1 = "L" sourceCol2 = "M" targetCol1 = "H" targetCol2 = "I" ElseIf wsMain.Range("G6").Value = "تامين" Then sourceCol1 = "O" sourceCol2 = "P" targetCol1 = "H" targetCol2 = "I" Else MsgBox "يجب اختيار 'قوى' أو 'تامين' في الخلية G6", vbExclamation + vbMsgBoxRight, "" Exit Sub End If wsMain.Range("H6:I" & wsMain.Rows.Count).ClearContents lastRow = wsTarget.Cells(wsTarget.Rows.Count, sourceCol1).End(xlUp).Row lastRow = Application.WorksheetFunction.Max(lastRow, wsTarget.Cells(wsTarget.Rows.Count, sourceCol2).End(xlUp).Row) For i = 6 To lastRow If wsTarget.Range(sourceCol1 & i).Value <> "" Then wsMain.Range(targetCol1 & (i - 0)).Value = wsTarget.Range(sourceCol1 & i).Value End If If wsTarget.Range(sourceCol2 & i).Value <> "" Then wsMain.Range(targetCol2 & (i - 0)).Value = wsTarget.Range(sourceCol2 & i).Value End If Next i MsgBox "تم نقل البيانات بنجاح", vbInformation + vbMsgBoxRight, "" End Sub جرب المرفق وأخبرنا بالنتيجة .. BB.zip

متابعه

لهذا السؤال :- هذا سيعتمد على ما إذا كان لكل موظف فترة واحدة فقط يومياً ( ومن سياق الحديث السابق لا اعتقد ذلك !! ) ، فيكفي ربط الدالة بمعرف الموظف فقط . أما إذا كان يمكن أن يسجل الموظف توقيعاً في أكثر من فترة (صباحي + مسائي) ، فهنا من الأفضل أن تأخذ الدالة أيضاً FtraID ( رقم الفترة ) لضمان دقة التحليل . والدالة الجميلة ، لي تعقيب واحد عليها . في السطر :- If minutes > 59 Then hours = hours + 1: minutes = 0 أرى أنه غير ضروري !! لأنه من المستحيل أن تكون minutes أكبر من 59 بسبب عملية Mod 60 السابقة !!!! أما فيما يخص الدالة ، فقط لأني سأخرج من العمل بعد قليل ، وسأحاول البدء بمشاركة بسيطة بأقرب فرصة .

تمام استاذنا قمت باعداد وضبط جدول الفترات ووضعت start_signin و end_signout حقول حقيقية في الجدول يمكنك الاطلاع على النموذج الآن نريد (دالة مربوطة بمعرف الموظف) في الوحدة النمطية .. تعالج جميع احتمالات الفترات الموجودة لا اعلم هل يكفي ربط معرف الموظف بالدالة ام نربط معه رقم الفترة ايضا على اعتبار ان رقم الفترة موجود في سجل الموظف comOutDb3.rar

السلام عليكم ورحمة الله وبركاته اخواتي في الله في الملف المرفق يوجد في العمود B مجموعه من ارقام ملفات مسجل بها بيانات اريد عند كتابة الرقم في الخليه F6 و كتابة نوع البيان بجانبها في الخليه G6 ان يقوم باستدعاء البيانات من شيت رقم الملف ويكتبها في العمود H6 و i6 الملف المرفق موضح المطلوب شكرا مقدما لكل من يساهم في حل المطلوب BB.xlsx

قد يكون تنسيق الوقت !!! لكن انظر الوقت والتنفيذ الآن .. دعنا منها الآن .👍. طبعاً إذا كان لكل فترة وقت إتاحة مخصص ومختلف عن الفترة السابقة . أي لا نريد شمول الفترات جميعها بوقت إتاحة ثابت !! ومن هنا كل شيء سيكون عبارة عن بيانات وليس برمجة .. وهذه خطوة ذكية جداً أنك ستعتمد على حقول محسوبة .. وعلى سبيل المثال بهذا الشكل رح نعتمد على start_signin و end_signout بدل ما نعتمد على VBA ( start_signin و end_signout = حقلين افتراضيات يعبران عن بداية ونهاية التوقيع )

تمام .. زادك الله علما .. وبارك فيك نعم هذا افضل كثيرا .. وإلا لماذا جعلنا وقت متاح قبل وبعد الوقت الرسمي للتوقيع ملاحظة : جرب الموظف سالم .. فترته خاص من التاسعة الى الحادية عشر ونصف صباحا لاحظت : الساعة عندي الآن 4:20 مساء 1- سمح له بالتوقيع 1- الرسالة تبين انه في الصباح رغم ان التوقيع الآن ...................................................................................................................................... دعنا الآن من الأكواد وضبطها لتحقيق الشروط المهم الآن هل الجداول وحقولها مكتملة ... وهل طريقة التصميم صحيحة اكتشفت الآن ان حقول الوقت المتاح قبل وبعد التوقيع يجب ان تكون ضمن جدول الفترات وفائدة ذلك : حصر الفترة الزمنية في مكان واحد .. لأن وقت التوقيع سيحصر الوقت : من/الى .. وغير جيد اضافة هذه الفترة داخل الجملة البرمجية صحيح سيوجد تكرار لأننا سنرصد هذه القيم امام كل فترة ، ولكن ايضا مفيد فيما لو اردنا تخصيص فترة ما بوقت متاح اكبر او اصغر اذا جدول الفترات يجب اعادة النظر فيه .. وسوف اقوم باعداده ورفعه ان شاء الله على النحو التالي : المعرف / الدخول الرسمي / الخروج الرسمي / فترة سماح دخول / فترة سماح خروج / وقت متاح قبل / وقت متاح بعد / بداية توقيع حضور/ نهاية توقيع خروج / ساعات(وقت العمل الفعلي) ما خط بالاحمر هو الذي تحصره الدالة .. ومن خلاله يتم قبول او رفض التوقيع .. بداية توقيع حضور = الدخول الرسمي - وقت متاح قبل نهاية توقيع خروج = الخروج الرسمي + وقت متاح بعد ساعات وقت العمل الفعلي = نستخرج الفرق بين الوقتين : ( الدخول الرسمي و الخروج الرسمي ) - فترات السماح المرونة هنا تتحقق .. فيمكن اجبار الموظفين على التوقيع في الوقت المحدد بدون وقت سماح .. واعتبار ساعات العمل كاملة من الدخول الرسمي وحتى الخروج الرسمي