عبدالفتاح في بي اكسيل

يبدو انك نسيت ان تضغط على ctrl+shift+enter لانها معادلة مصفوفة لذلك لم تعمل معك تفضل إدراج الاسماء تلقائي.xlsx

ادرج ملف واعطين تصور للنتائج داخل الملف

ادرج الملف وماذا تريد بالضبط مسح خلايا كاملة اما ماذا

لم افهم عليك وضح اكثر

هل ممكن التوضيح اكثر بوضع تصور والنتائج المتوقعة داخل الشيت

تفضل لعل هذا ما تبحث عنه لقد تم الغاء خلايا الدمج وتسمية الاوراق بالانجليزي حتى يعمل الكود ملاحظة اخيرة لا تضغط الملف مرة اخرى posting.xlsm

كان من المفترض توضيح ما تريد حتى يتم العمل على الملف منذ البداية تفضل نصرالدين البلداوي.xlsm

يمكنك اضافة رموز اخرى تفضل هذا الكود Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) On Error Resume Next If InStr("/\? * [ ]", Chr(KeyAscii)) Then KeyAscii = 0 End Sub

تم معالجة الامر تفضل نصرالدين البلداوي.xlsm

تاكد من هذا البرنامج Net framework موجود في جهازك وان يكون اخر اصدار لعل المشكلة منه

لقد قلت لك بعد ثاني سطر في الكود خطاك قمت بوضعه بعد اول سطر تفضل تنسيق شرطى لكل الملف.xlsm

لماذا لم تجيبني على سؤالي ؟؟؟؟

اخ محمد ماذا تقصد بعدم التكرار هل تريد مج البيانات المكررة مع بعضها ام تريد تجاهل المكرر نهائيا

اعذرني اخي لا املك لك اي تفسير الكود شغال معي 100% اقترح عليك تصميم ملف جديد قد تكون المشكلة منه

ضع هذا السطر بعد ثاني سطر في الكود Rng.Interior.Color = xlNone

على حسب ما فهمت منك ضعه في هذا الحدث Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) End Sub

جرب هذا الكود لعله يفيدك ولكن لمدى محدد كما في ملف عملك من العمود a: j يمكنك التعديل على الكود وتغيير المدى Sub test() For Each sh In Worksheets Set Rng = Sheets(sh.Name).Range("A:J") With Sheets(sh.Name) Set c = Rng.Find("تم", lookat:=xlWhole) If Not c Is Nothing Then FirstAddress = c.Address Do Set x1 = .Range("A" & c.Row) Set x2 = .Range("J" & c.Row) .Range(x1, x2).Interior.Color = RGB(255, 0, 0) Set c = Rng.FindNext(c) Loop While c.Address <> FirstAddress End If Set c = Rng.Find("انجز", lookat:=xlWhole) If Not c Is Nothing Then FirstAddress = c.Address Do Set x1 = .Range("A" & c.Row) Set x2 = .Range("J" & c.Row) .Range(x1, x2).Interior.Color = RGB(0, 0, 255) Set c = Rng.FindNext(c) Loop While c.Address <> FirstAddress End If End With Next End Sub

اختي الكريمة الكود يقوم بحماية الاعمدة a,b,c فقط دون حماية الورقة يمكنك الكتابة في الاعمدة الاخرى دون مشاكل

بعد اذن استاد سليم جربي هذا الملف حماية اعمدة محددة بالكود‬.xls

بعذ اذن استادنا الكبير سليم واثراء للموضوع Sub coundat() Dim lrD As Long Dim lrC As Long Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("ورقة1") 'change as needed lrD = ws.Range("D" & Rows.Count).End(xlUp).Row lrC = ws.Range("C" & Rows.Count).End(xlUp).Row If lrD >= lrC Then Exit Sub With Range(Range("D" & lrD), Range("D" & lrC)) .Formula = "=Today()-C" & lrD .Value = .Value .NumberFormat = "General" End With End Sub الايام المتبقية.xlsm

عنوان الموضوع وطرحك لم تقل ملفات بناء عليه ارفقت طلبك

جرب هذا الملف لعله يفيدك consolidate datat.xls

اخي الكريم طلبك غريب بخصوص العمود a عبارة عن ترقيمات ليس بيانات مهمة يمكنك ترقيم ذلك اوتوماتيكيا اما من خلال المعادلة اوالكود وهذه متوفرة بكثرة في المنتدى

بعد اذن الاساتذة لا داعي للكود كل ماعليك هو الضغط على هذين الزرين alt+enter

ايضا هذا كود اخر جميل وتعدد الخيارات بمجرد تشغيل تستطيع تحدد العمود الذي تريد من تحدف منه البيان وكذلك الكلمة او القيمة التي تريدها Sub DeleteRows() 'Updateby20140314 Dim rng As Range Dim InputRng As Range Dim DeleteRng As Range Dim DeleteStr As String xTitleId = "KutoolsforExcel" Set InputRng = Application.Selection Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2) For Each rng In InputRng If rng.Value = DeleteStr Then If DeleteRng Is Nothing Then Set DeleteRng = rng Else Set DeleteRng = Application.Union(DeleteRng, rng) End If End If Next DeleteRng.EntireRow.Delete End Sub