ياسر خليل أبو البراء

وعليكم السلام أين الملف المرفق المعبر عن الطلب ..؟ مع وضع بعض النتائج المتوقعة ليسهل على الأخوة الأعضاء تقديم المساعدة المطلوبة

نعم أخي يمكنك تغيير المدى في هذا السطر Set rngCom = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeComments)

ارفق الملف الذي به المشكلة للإطلاع عليه تقبل تحياتي

وعليكم السلام إن شاء الله غداً أحاول الإطلاع على الملف أما الليلة فقد تأخر الوقت .. ربنا ييسر الأمور إن شاء الله جرب الكود التالي (مع العلم أن التاريخ المدرج في التعليق يتبع النظام الأمريكي حيث يبدأ بالشهر ثم اليوم) عموماً جرب .. وبذلك يكون لديك كلا الطريقتين Sub Test() Dim rngCom As Range Dim cCom As Range Dim strCom As String Dim x As Variant Dim strDay As String Dim y As Variant Dim strDate As String Dim strDayNew As String Dim str As String Dim z As Variant Application.ScreenUpdating = False With ActiveSheet On Error Resume Next Set rngCom = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeComments) On Error GoTo 0 If rngCom Is Nothing Then MsgBox "No Comments Found", vbExclamation Exit Sub End If For Each cCom In rngCom strCom = cCom.Comment.Text x = Split(Application.WorksheetFunction.Trim(strCom), vbLf) strDay = x(1) y = Split(strDay) strDay = Trim(y(2)) strDate = x(2) z = Split(strDate) str = Split(z(0), ".")(1) & "/" & Split(z(0), ".")(0) & "/" & Split(z(0), ".")(2) strDayNew = Application.Text(str, "[$-409]dddd") If strDayNew <> strDay Then cCom.Comment.Text Replace(strCom, strDay, strDayNew) End If Next cCom End With Application.ScreenUpdating = True End Sub

أعتقد الموضوع مكرر .. عموماً أخي الكريم يفضل أن يكون الموضوع لطلب واحد فقط ، حيث أن المشاركات الفرعية لا يلتفت إليها الكثير من الأعضاء بارك الله فيك أخي الغالي خالد الرشيدي على متابعتك الرائعة لمشكلات الأعضاء تقبلوا تحياتي

وعليكم السلام يرجى وضع الملف الذي توصلت إليه ووضع الرابط ليستفيد الجميع تقبل تحياتي

قم بالإشارة لورقة العمل قبل هذا الجزء Range("a1:a50000") بهذا الشكل Sheets("Sheet1").Range("a1:a50000") حيث Sheet1 هو اسم ورقة العمل ...

أخي الكريم أبو سلمان أليس هذا الموضوع طرح من قبل ووجدت الحل؟ لا أتذكر .. ولكن أعتقد أن الأمر تم من قبل إذا كان الأمر كذلك يرجى إرفاق الحلول التي جربتها لنتأكد من صحة المخرجات جرب تحديد العمود الذي يحتوي على التواريخ ، ثم من التبويب Data ستجد أمر اسمه Text to Columns انقر عليه ثم انقر finish تقبل تحياتي

أخي الكريم أبو جاسم هل اطلعت على الكود في الرابط المشار إليه من قبل أخونا محمد ، وقمت بتطبيقه؟ إذا كان الأمر كذلك قم بإرفاق ملفك مرة أخرى بعد التطبيق للإطلاع عليه ومحاولة تقدي المساعدة إذا تيسر لي العلم

شاهد الفيديو على الرابط التالي https://www.youtube.com/watch?v=lcu5rsRgndI&t=3s

السلام عليكم هذا موضوع قد يفيد الجميع بخصوص الطلبات المرتبطة بمثل هذا الأمر رابط الموضوع من هنا

أعتذر إليك لضيق الوقت لدي .. يمكن لأحد الأخوة الأفاضل التطوع وحاولة التعديل على الكود الموجود ليتناسب مع ملفك الثاني فأنا عادةً لا أعمل إلا على ملف مرفق واحد داخل الموضوع تقبل تحياتي

جرب استخدام الكود التالي في حدث المصنف Private Sub Workbook_Open() With ActiveSheet If CDate("20/03/2017") = CDate(Split(.Range("A4").Value)(0)) Then .Range("G3") = 3 End If End With End Sub

وجزيت خيراً أخي بمثل ما دعوت لي الحمد لله الذي بنعمته تتم الصالحات

السلام عليكم الكود يعمل بشكل جيد حيث يقوم الكود أولاً بإخفاء كل الأعمدة K:IZ ثم بعد ذلك يظهر الأعمدة من K:P ... ماذا يحدث معك بالضبط أو ما المشكلة التي تصادفك؟ إذا كنت من مستخدمي أوفيس 2003 (أمتنع عن الاستمرار في المشاركة في الموضوع حيث أنني لا أمتلك نسخة أوفيس 2003)

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

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

حدد ورقة العمل بالكامل اعمل كليك يمين ثم اختر نسخ Copy ثم كليك يمين مرة أخرى واختر Paste Special ومن النافذة التي ستظهر معك اختر Values تقبل تحياتي

تفضل الملف ... وحاول تقرأ التوجيهات في مشاركتي السابقة لتتعلم كيفية وضع الدوال المعرفة وكيفية استخدامها بنفسك XYZ sample.rar

أخي الكريم اطلع على الرابط التالي بشكل جيد أولاً وإذا صادفتك مشكلة أبلغنا بها (لابد من معرفة أبجديات التعامل مع البرمجة) الرابط من هنا

منور المنتدى أخي وحبيبي في الله خالد الرشيدي لكم أعشق رؤية ردودك في المنتدى .. تقبل وافر تقديري واحترامي

ضع الدالة المعرفة التالية (توضع في موديول وتستخدم في ورقة العمل كالمعادلات) اضغط Alt + F11 لفتح محرر الأكواد >> من قائمة Insert قم بإداج موديول جديد >> انسخ الدالة المعرفة التالية وضعها في الموديول Function Translate(s As String) As String Dim dic As Object Dim arr As Variant Dim i As Long Dim j As Long Dim c As String Dim r As String r = s Set dic = CreateObject("Scripting.Dictionary") arr = Array("0", "X", "Y", "Z", "A", "B", "C", "D") For i = 1 To Len(s) c = Mid(s, i, 1) If c <> "0" Then If Not dic.exists(c) Then dic.Add c, c j = j + 1 r = Replace(r, c, arr(j)) End If End If Next i Translate = r End Function الآن قم بوضع المعادلة التالية في الخلية B2 =Translate(A2)

راجع الرابط التالي ربما يفيدك من هنا

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

الموضوع فيه لبس في المنطق ... في المثال المرفق من قبل الأخ سامي يوجد في الصف الثاني 3443043 والناتج المطلوب XYYX0XY أليس حسب المنطق المشروح في المشاركة الأولى أن يكون بهذا الشكل XYYX0YX ؟؟ في ملف الأخ سليم خرجت النتيجة بهذا الشكل XYZA0CD يرجى تأكيد المنطق الصحيح لكيفية إجراء العملية ، والرد على تساؤلي ما الهدف من إجراء تلك العملية؟