تعديل على التاريخ في الكومنت

[Alttear]

السلام عليكم

بعد ان قمت بتشغيل ملف الاكسيل على سيرفر اميركي اصبحت الايام مخالفة للتواريخ الموجودة في الكومنت

هل لو سمحتم ملف Vba يقرأ التاريخ الموجود في الكومنت و يعدل على اليوم ليصبح مساويا للتاريخ المقرون به

في الملف المرفق صيغة التاريخ الخاظئة و الصحيحة

مع الشكر Kitap1.rar

Kitap1.rar

[Alttear]

Up

[Alttear]

Up up Up

[Alttear]

السلام عليكم

اخواني الكرام هلا تفضل احدكم ببرمجة الملف !
 

[Alttear]

هل الفكرة صعبة ؟

[Alttear]

            

[Alttear]

UP UP UP

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

أخي الكريم

لا فائدة من رقع الموضوع طالما أن الطلب غير واضح ...بدلاً من الرفع قم بإلقاء مزيد من الضوء حول المشكلة ولو بالصور لكي تتضح صورة المشكلة

حيث لا مشاركات في موضوع مبهم (راجع التوجيهات في الموضوعات المثبتة في صدر المنتدى)

[Alttear]

17 ساعات مضت, ياسر خليل أبو البراء said:

أخي الكريم

لا فائدة من رقع الموضوع طالما أن الطلب غير واضح ...بدلاً من الرفع قم بإلقاء مزيد من الضوء حول المشكلة ولو بالصور لكي تتضح صورة المشكلة

حيث لا مشاركات في موضوع مبهم (راجع التوجيهات في الموضوعات المثبتة في صدر المنتدى)

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

Comment Correctıon.rar

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

جرب الكود التالي (تم العمل على الملف الأصلي في المشاركة الأولى بعد فهم المطلوب)

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 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)
                strDayNew = Application.Text(Replace(z(0), ".", "/"), "[$-409]dddd")
                If strDayNew <> strDay Then
                    cCom.Comment.Text Replace(strCom, strDay, strDayNew)
                End If
            Next cCom
        End With
    Application.ScreenUpdating = True
End Sub

 

[Alttear]

اخي الكريم استاذ ياسر

السلام عليكم و شكرا لك على هذه الفائدة الكريمة

الكود كما تفضلت به يعمل بصورة صحيحة و لكن في الملف الاول كنت قد اخطأءت في كتابة الصح و الخطأ حيث قمت بوضع القيم الصحيحة تحت الخاطئة

يرجى لو تفضلت ادخال الكود على الملف الثاني لتظهر البيانات كما في هي تحت العمود الصحيح في الملف الثاني

جزاك الله خيرا و شكرا لك

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

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

تقبل تحياتي

[Alttear]

لك الحق في ماتقول .. شكرا لك على مجهودك معي

[Alttear]

اخواني الكرام

الكود التالي من برمجة الاستاذ الكريم ياسر خليل

يقوم بقراءة الكومنت و مسح اليوم الموجود فيها و كتابة يوم جديد حسب التاريخ الموجود

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

في 13/02/2017 at 23:05, ياسر خليل أبو البراء said:

جرب الكود التالي (تم العمل على الملف الأصلي في المشاركة الأولى بعد فهم المطلوب)

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 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)
                strDayNew = Application.Text(Replace(z(0), ".", "/"), "[$-409]dddd")
                If strDayNew <> strDay Then
                    cCom.Comment.Text Replace(strCom, strDay, strDayNew)
                End If
            Next cCom
        End With
    Application.ScreenUpdating = True
End Sub

 

 

Comment Correctıon.rar

[Alttear]

بعد تأكيد
عمل ملف جيد جدا
شكرا

تم تعديل فبراير 18, 2017 بواسطه Alttear

[Alttear]

السلام عليكم

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

يرجى التفضل و بيان اين المشكلة

test comment.rar

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

وعليكم السلام

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

جرب الكود التالي (مع العلم أن التاريخ المدرج في التعليق يتبع النظام الأمريكي حيث يبدأ بالشهر ثم اليوم)
عموماً جرب .. وبذلك يكون لديك كلا الطريقتين

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

 

[Alttear]

ماشاء الله .. تمام اخي العزيز 

هذا هو المطلوب

بالنسبة للرينج هل يمكن جعلها على كافة الخلايا

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

نعم أخي يمكنك تغيير المدى في هذا السطر

 Set rngCom = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeComments)

 

[Alttear]

في 19.02.2017 at 01:14, ياسر خليل أبو البراء said:

وعليكم السلام

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

جرب الكود التالي (مع العلم أن التاريخ المدرج في التعليق يتبع النظام الأمريكي حيث يبدأ بالشهر ثم اليوم)
عموماً جرب .. وبذلك يكون لديك كلا الطريقتين

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

 

السلام عليكم

استاذي الكريم هل ممكن لو تفضلت و اخبرتني ما المشكلة في هذا الملف 
الايام لاتكتب ,, بل يكتب التاريخ عوضا عنها

 

test comment.rar

[Alttear]

السلام عليكم

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

Date Fix.rar