fantap

السلام عليكم تم التعديل علي الكود و تم الاصلاح و لكن يوجد بطئ شديد جدا في تكوين الشيت الجديد Sub CreateNextMonthSheetAndLockOfficialHolidays() Dim ws As Worksheet, copiedSheet As Worksheet, monthTable As Worksheet, dataSheet As Worksheet Dim currentMonth As String, nextMonth As String, nextMonthArabic As String Dim i As Integer, foundRow As Range Dim dateCell As Range, checkDate As Date Dim holidayRange As Range, holidayCell As Range Dim col As Range Dim isHoliday As Boolean Dim colNum As Long Dim weekdayNum As Integer Dim lockedText As String ' إعداد الشيتات Set ws = ActiveSheet Set monthTable = ThisWorkbook.Sheets("MonthNames") Set dataSheet = ThisWorkbook.Sheets("data") currentMonth = ws.Name ' جلب النص من MonthNames!H1 lockedText = monthTable.Range("H1").Value ' البحث عن اسم الشهر الحالي Set foundRow = monthTable.Range("A1:A12").Find(What:=currentMonth, LookIn:=xlValues, LookAt:=xlWhole) If foundRow Is Nothing Then MsgBox "Current sheet name '" & currentMonth & "' not found in MonthNames sheet.", vbCritical Exit Sub End If ' تحديد الشهر التالي If foundRow.Row = 12 Then nextMonth = monthTable.Range("A1").Value nextMonthArabic = monthTable.Range("B1").Value Else nextMonth = monthTable.Cells(foundRow.Row + 1, 1).Value nextMonthArabic = monthTable.Cells(foundRow.Row + 1, 2).Value End If ' التأكد أن الشيت غير موجود مسبقًا For i = 1 To ThisWorkbook.Sheets.Count If ThisWorkbook.Sheets(i).Name = nextMonth Then MsgBox "Sheet '" & nextMonth & "' already exists.", vbExclamation Exit Sub End If Next i ' نسخ الشيت الحالي ws.Copy After:=ws Set copiedSheet = ActiveSheet On Error Resume Next copiedSheet.Name = nextMonth If Err.Number <> 0 Then MsgBox "Error renaming the new sheet.", vbCritical Exit Sub End If On Error GoTo 0 ' تفريغ البيانات copiedSheet.Range("F11:AJ500").ClearContents ' تحديث D5 copiedSheet.Range("D5").Value = nextMonthArabic ' فك الحماية copiedSheet.Unprotect Password:="1234" copiedSheet.Range("F11:AJ130").Locked = False ' قراءة العطلات من الشيت "data" Set holidayRange = dataSheet.Range("F5:F25") ' المرور على الأعمدة من F إلى AJ (أرقام الأعمدة 6 إلى 36) For colNum = 6 To 36 Set dateCell = copiedSheet.Cells(10, colNum) Set col = copiedSheet.Range(copiedSheet.Cells(11, colNum), copiedSheet.Cells(130, colNum)) isHoliday = False If IsDate(dateCell.Value) Then checkDate = CDate(dateCell.Value) ' ترتيب الأسبوع يبدأ من السبت: السبت = 1، الجمعة = 7 weekdayNum = Weekday(checkDate, vbSaturday) ' التحقق من العطلات الرسمية (تجاهل الوقت) For Each holidayCell In holidayRange If IsDate(holidayCell.Value) Then If Int(CDate(holidayCell.Value)) = Int(checkDate) Then isHoliday = True Exit For End If End If Next holidayCell ' إذا الجمعة أو السبت أو عطلة If isHoliday Or weekdayNum = 1 Or weekdayNum = 7 Then Dim r As Range For Each r In col If Trim(r.Value) = "" Then r.Value = lockedText End If Next r col.Locked = True On Error Resume Next col.Validation.Delete On Error GoTo 0 End If End If Next colNum ' إعادة الحماية copiedSheet.Protect Password:="1234", UserInterfaceOnly:=True ' تفعيل الشيت الجديد copiedSheet.Activate MsgBox "✅ Sheet '" & nextMonth & "' has been created successfully." & vbCrLf & _ "✔ Fridays, Saturdays, and official holidays are now locked.", vbInformation End Sub تم عمل كود لتسريع العمليه الانشاء فعلا تم الانشاء بسرعه عاليه و لكن لم يقم بغلق الجمعه و السبت و لكن تم اغلاق الاثنين و الثلاثاء برجاء المساعده في تحديث الكود ليصبح ان يغلق الجمعة و السبت و العطلات الرسميه بدلا من الاثنين و الثلاثاء و مرفق الكود و لكن لا يعمل بشكل صحيح Sub CreateNextMonthSheetAndLockOfficialHolidays() ' تسريع الكود Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Dim ws As Worksheet, copiedSheet As Worksheet, monthTable As Worksheet, dataSheet As Worksheet Dim currentMonth As String, nextMonth As String, nextMonthArabic As String Dim i As Integer, foundRow As Range Dim dateCell As Range, checkDate As Date Dim holidayRange As Range, holidayCell As Range Dim col As Range Dim isHoliday As Boolean Dim colNum As Long Dim weekdayNum As Integer Dim lockedText As String ' إعداد الشيتات Set ws = ActiveSheet Set monthTable = ThisWorkbook.Sheets("MonthNames") Set dataSheet = ThisWorkbook.Sheets("data") currentMonth = ws.Name ' جلب النص من MonthNames!H1 lockedText = monthTable.Range("H1").Value ' البحث عن اسم الشهر الحالي Set foundRow = monthTable.Range("A1:A12").Find(What:=currentMonth, LookIn:=xlValues, LookAt:=xlWhole) If foundRow Is Nothing Then MsgBox "Current sheet name '" & currentMonth & "' not found in MonthNames sheet.", vbCritical GoTo Cleanup End If ' تحديد الشهر التالي If foundRow.Row = 12 Then nextMonth = monthTable.Range("A1").Value nextMonthArabic = monthTable.Range("B1").Value Else nextMonth = monthTable.Cells(foundRow.Row + 1, 1).Value nextMonthArabic = monthTable.Cells(foundRow.Row + 1, 2).Value End If ' التأكد أن الشيت غير موجود مسبقًا For i = 1 To ThisWorkbook.Sheets.Count If ThisWorkbook.Sheets(i).Name = nextMonth Then MsgBox "Sheet '" & nextMonth & "' already exists.", vbExclamation GoTo Cleanup End If Next i ' نسخ الشيت الحالي ws.Copy After:=ws Set copiedSheet = ActiveSheet On Error Resume Next copiedSheet.Name = nextMonth If Err.Number <> 0 Then MsgBox "Error renaming the new sheet.", vbCritical GoTo Cleanup End If On Error GoTo 0 ' تفريغ البيانات copiedSheet.Range("F11:AJ500").ClearContents ' تحديث D5 copiedSheet.Range("D5").Value = nextMonthArabic ' فك الحماية copiedSheet.Unprotect Password:="1234" copiedSheet.Range("F11:AJ130").Locked = False ' قراءة العطلات من الشيت "data" Set holidayRange = dataSheet.Range("F5:F25") ' المرور على الأعمدة من F إلى AJ (أرقام الأعمدة 6 إلى 36) For colNum = 6 To 36 Set dateCell = copiedSheet.Cells(10, colNum) Set col = copiedSheet.Range(copiedSheet.Cells(11, colNum), copiedSheet.Cells(130, colNum)) isHoliday = False If IsDate(dateCell.Value) Then checkDate = CDate(dateCell.Value) ' استخدام Weekday مع vbSaturday: السبت = 1، الجمعة = 7 weekdayNum = Weekday(checkDate, vbSaturday) ' التحقق من العطلات الرسمية For Each holidayCell In holidayRange If IsDate(holidayCell.Value) Then If Int(CDate(holidayCell.Value)) = Int(checkDate) Then isHoliday = True Exit For End If End If Next holidayCell ' إذا الجمعة (7) أو السبت (1) أو عطلة If weekdayNum = 1 Or weekdayNum = 7 Or isHoliday Then ' كتابة "خلية مغلقة" من MonthNames!H1 في الخلايا الفارغة Dim r As Range For Each r In col If Trim(r.Value) = "" Then r.Value = lockedText End If Next r ' قفل العمود وحذف القائمة المنسدلة col.Locked = True On Error Resume Next col.Validation.Delete On Error GoTo 0 End If End If Next colNum ' إعادة الحماية copiedSheet.Protect Password:="1234", UserInterfaceOnly:=True ' تفعيل الشيت الجديد copiedSheet.Activate MsgBox "✅ Sheet '" & nextMonth & "' has been created successfully." & vbCrLf & _ "✔ Fridays, Saturdays, and official holidays are now locked.", vbInformation Cleanup: ' إعادة الإعدادات لطبيعتها Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.DisplayAlerts = True End Sub

السلام عليكم برجاء المساعدة في غلق ايام الجمعة و السبت و العطلات الرسميه عند الضغط علي شهر جديد و لا يجوز كتابة فيها اي مدخلات عن طريق الخطا مثلا و ازالة القائمة المنسدلة عن تلك الايام فقط حيث عندا نضغط علي شهر جديد بيتم انشاء شهر جديد في شيت جديد له نفس الترتيب ايام الجمعة السبت بتختلف من شهر الي اخر ايام الجمعة و السبت لها لون مميز برجاء المساعدة Untitled - Copy - Copy.xlsm

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

شكرا جزيلا مجهود مميز و لكني لا اريد استخدام معادلات ولا استخدام اكواد VBA خالص الاحترام و التقدير لشخصكم الكريم

السلام عليكم مرفق شيت اكسيل اريد عمل تصفيه متقدمه بحيث اريد تصفيه القيم التي تبدا بـ 110 و التي تبدا بـ 111 و التي تبدا بـ 112 و التي تبدا بـ 113 و استباعدهم و الابقاء علي باقي القيم حيث تم اضافة جدول مساعد و تم تسميه باسم نفس العمود الذي عليه معيار التصفيه كالتالي في العمود Q <>110* <>111* <>112* <>113* و لكن لا تعمل التصفيه لا ادري لماذا برجاء المساعدة مع العلم انني اعمل التصفيه في نفس الشيت علما انه تم تحويل كل القيم الي الصورة النصيه.... شكرا جزيلا انا اريد استخدام التصفيه المتقدمه و لا اريد استخدام المعادلات او استخدام اكواد VBA ايداعات.xlsx

شكرا جزيلا بارك الله في حضرتك.... خالص الاحنترام و التقدير

السلام عليكم مرفق ملف اكسيل يحتوي علي 2 شيت اكسيل الشيت الرئيسي هو شيت العملاء مكون من عدد 7 اعمدة العمود الاول هو اسم العميل العمود الثاني هو رقم حساب العميل العمود الثالث هو الايداع النقدي العمود الرابع هو السحب النقدي العمود الخامس هو تحويلات الخارجيه العمود السادس هو للتحويلات الداخليه العمود السابع هو للفتح الجديد و الشيت الثاني يسمي شيت الشرايح اريد عندما اعمل عند عمل نسخ و لصق اسماء العملاء و بيانتهم يتم رحيل البيانات حسب شرائيهم في الجدول الثاني بشكل التوماتيكي بحيث لو ان العميل يقوم باي عمليه مثلا مثلا يتم ترحيل العميل حسب الشريحه الخاصه به و نوع العمليه سواء كانت ايداع او سحب او تحويل داخلي او خارجي او فتح جديد و عمل اجمالي حسب المبالغ الخاصه به شرائح.xlsx

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

السلام عليكم و رحمة الله و بركاته مرفق شيت اكسيل مكون من عمود واحد فقط باسم رقم الحساب يكون به حجم بيانات ضخم جدا ..... انا اريد ان اعمل فرز و تصفيه للارقام الحسابات التي تبدا بـ فقط 080 و ايضا 081 و ايضا 082 برجاء المساعدة لان الطريقه التقلديه للفرز لا تفي بهذا الغرض و كيفية عمل ذلك شكرا جزيلا ارقام حسابات.xlsx

السلام عليكم برجاء المساعدة في عمل Grouping باستخدام pivot table لقيم مختلفة المدي علي سبيل المثال للتوضيح عمل جروب للشريحه الاولي من 1 الي 1000 و الشريحه الثانيه من 1000 الي 10000 و الشريحه الثالثه من 10000 الي 40000 و هكذا باستخدام pivot table و مرفق مثال عملي و لكن range منتظم من البيانات شكرا جزيلا تقبلوا تحياتي مثال عملي .xlsx

للرفع

السلام عليكم انا عندي عمود يسمي رقم الحساب ( عبارة عن نص) داخل pivot table و اريد ان اعمل تصفيه من خلال التسميه و اريد ان اظهر ارقام الحسابات التي تبدا بـ 080 و ايضا ارقام الحسابات التي تبدا بـ 081 في نفس الوقت لا استطيع فعل ذلك برجاء مساعدتي في هذا الشان مرفق مثال و تم ارفاق صور مثال.xlsx

شكرا جزيلا لقد قمت بعمل الطريقه الاولي text to columns و كانت النتيجه ممتازة

السلام عليكم عندي مشكله مع شريط الاكسيل الخاص بي حيث الشيت من ضمن محتوايه عمودين (اسم العمود الاول تاريخ الاصدار ومعه توقيت الاصدار و العمود الثاني عمود الصرف و معه توقيت الصرف) و العمودين متجاورين مع بعضهم يمكن ان يكون ان يكو ن تاريخ الاصدار هو نفسه تاريخ الصرف و ممكن ان يكون تاريخ الصرف بعد تاريخ الاصدار المشكله عندما اقوم بعمل تعبئة سريعه لفصل تاريخ الصرف عن توقيت الصرف يقوم بعمل تعبئه سريعه علي اساس تاريخ الاصدار و ليس تاريخ الصرف فبتالي سوف يكون اختلاف في العمود الجديد ملحوظة اقوم بعمل اخفاء لتاريخ و وقت الاصدار حتي لا تحدث هذه المشكله.هل يوجد حل بديل بدلا من عمل اخفاء لاي عمود داخل الشيت الخاص بي ..شكرا جزيلا مثال.xlsx

للرفع

السلام عليكم الرجاء المساعدة في حل مشكلة عدم ظهور كافة العناصر عند عمل تصفيه في شيتات الاكسيل كبيرة الحجم حيث يظهر فقط اول 1000 عنصر و لا تظهر باقي العناصر الاخري داخل القائمة المنسدلة الخاصه بالتصفية مرفق صورة للتوضيح شكرا جزيلا مقدما مع خالص تحياتي

شكرا جزيلا ....🥰 الطريقة التي قمت بسردها اوحت لي فكرة اخري قمت بتجربتها و نجحت معي بنسبة 100% انا لا اريد فرز و تصفية علي نوع الحساب ( هذا لا يعنيني في شئ) المهم بالنسبة الي هو العميل الذي قام بعمليات الايداع تلك و بناء علي ذلك قمت بتعديل الصفوف ليظهر لي اسماء جميع العملاء في المقدمه هنا حل حل مشكلتي شكرا جزيلا مرة اخري ... مجهود تشكر عليه ..... و الله ينور عليك يا غالي

تمت التجربه اخي الكريم علي شيت كبير مكون من 9000 صف و استغل تمام اما الوقت لم يستغرق سوي لخطات قليه و لكن وجدت انه يوجد عميلين مختلفين لهم نفس اللون هل من الممكن اضافه اللوان نمط النقش اللي الالوان حتي لا يكون فيه وجود تكررات للاوان شكرا جزيلا اخي الكريم موفق باذن الله تعالي

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

شكرا جزيلا مجهود رائع و مميز جدا جدا جدا لقد قمت بالتجربه و هذا الكود اشتغل بشكل ممتاز و انا عندي استفسار اخير من فضلك وهو اريد تفعيل هذا الكود علي العمود رقم 8 ( اسم المودع) من الشيت الخاص بي كيف اعدل علي هذا الكود ليفي بهذا الغرض و في النهايه انا مقدر مجهود المتميز جدا جدا جدا موفق اخي الكريم مع خالص تحياتي ايداعات عملاء.xlsx

شكرا جزيلا ... و لكن ليس هذا الحل الذي اريده ومرفق صور للتوضيح

السلام عليكم مرفق لسيادتكم جدول لمجموعه من العملاء الذين يقومون بعمليات ايداع علي حساباتهم الشخصيه و اجمالي هذه الايداعات مبلغ 1314000 جنيه تم عمل privo table لمعرفة جميع العملاء التي تزيد او تساوي مجموع ايداعتهم عن مبلغ 250000 جنيه . و لكن المشكلة بعد عمل التصفيه و ظهور العملاء و عند الضغط علي الاجمالي الكلي دبل كليك او (الضغط بمفتاح الفاره الايمن علي الاجمالي الكلي و اختيار اظهار التفاصيل) يفتح شيت جديد به اسماء جميع العملاء و به جميع التعاملات التي تمت علي جميع الحسابات ) و لايظهر تعاملات العملاء التي تذيد او تساوي عن 250000 فقط يرجاء المساعده في ذلك شكرا جزيلا ايداعات عملاء.xlsx

كيف استفيد بهذ الكود ... انا ليس لدي اي خبره قي مجال برمجة .... شكرا جزيلا

هل من الممكن تثبيت لون ثابت للاسماء بدون تكرار .... حيث استطيع ان اقم بتمييز العملاء الغير متكررين بهذا اللون شكرا جزيلا

شكرا جزيلا ممتاز .... و لكن يوجد عندي استفسارين 1- انا لست بمثل خبرتك استاذي الفاضل ابو عيد جزاك الله خيرا ... كيف ادرج هذه الكواد في الشيت الرئيسي الخاص بي 2- عند ادخال اسم جديد في الشيت و لكن لا يوجد له تكرار لها الاسم يقوم ايضا بتلوين الخليه باللون .... ان امكن اذا الاسم غير مكرر لا يقوم بتلوين الخليه و تستمر علي نفس لونها الاساس بدون تلوين.. مجهود تشكر عليه زز وانا مقدر تعبك و مجهوداتك شكرا جزيلا مرة ثانيه