مطلوب تعديل الكود

[ehabaf2]

الاخوة الافاضل 

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

عاوز اعرف اعدل ازاى الاعمدة اللى بيعمل عليها الكود

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WRng As Range, WRng2 As Range
Dim rg As Range, rg2 As Range
Dim ST1 As Integer, ST2 As Integer
Set WRng = Intersect(Application.ActiveSheet.Range("B8:B1000"), Target)
Set WRng2 = Intersect(Application.ActiveSheet.Range("d8:d1000"), Target)
On Error Resume Next
ST1 = 1
ST2 = 1

If Not WRng Is Nothing Then
    Application.EnableEvents = False
    For Each rg In WRng
        If Not VBA.IsEmpty(rg.Value) Then
            rg.Offset(0, ST1).Value = Now
            rg.Offset(0, ST1).NumberFormat = "dd-mm-yyyy HH:mm"
        Else
            rg.Offset(0, ST1).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
If Not WRng2 Is Nothing Then
    Application.EnableEvents = False
    For Each rg2 In WRng2
        If Not VBA.IsEmpty(rg2.Value) Then
            rg2.Offset(0, ST2).Value = Now
            rg2.Offset(0, ST2).NumberFormat = "dd-mm-yyyy HH:mm"
        Else
            rg2.Offset(0, ST2).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

تم تعديل مارس 1, 2023 بواسطه ehabaf2

[محي الدين ابو البشر]

Set WRng = Intersect(Application.ActiveSheet.Range("B8:B1000"), Target) 'المجال الأول وهو العمود B
Set WRng2 = Intersect(Application.ActiveSheet.Range("d8:d1000"), Target) 'المجال الثاني وهو العمود D
On Error Resume Next
ST1 = 1 ' عدد إزاحة النتيجة الذي سيتم وضع نتيجة فحص العمود  B في هذه الحالة سيتم الإزاحة بمقدر 1 اي النتيجة ستكون في العمو د C
ST2 = 1 ' عدد إزاحة النتيجة الذي سيتم وضع نتيجة فحص العمود  D في هذه الحالة سيتم الإزاحة بمقدر 1 اي النتيجة ستكون في العمو د F

 

[حسونة حسين]

وعليكم السلام ورحمة الله وبركاته 

اخى هذا كود بسيط ليسهل عليك تعديله

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim X As Range
    For Each X In Target
        If X.Column = 2 Or X.Column = 4 Then            ' العمود رقم 2 والعامود رقم 4
            If X.Row > 7 Then                           'رقم الصف اكبر من 7
                If X.Value = "" Then
                    X.Offset(0, 1) = ""
                Else
                    On Error Resume Next
                    X.Offset(0, 1) = ""
                    X.Offset(0, 1) = Now
                    X.Offset(0, 1).NumberFormat = "dd-mm-yyyy HH:mm"
                End If
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub

 

[ehabaf2]

السلام عليكم استاذنا الفاضل حسونة حسين 

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

و الف شكر لحضرتك استاذنا الفاضل

خطوط.xlsm

[محي الدين ابو البشر]

ربما

BookXX.xlsm

[حسونة حسين]

لا تكرر الكود لكن ضيف عليه الاعمده

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    Dim X As Range
    For Each X In Target
        If X.Column = 2 Or X.Column = 4 Or X.Column = 18 Or X.Column = 20 Then
            If X.Row > 7 Then
                If X.Value = "" Then
                    X.Offset(0, 1) = ""
                Else
                    On Error Resume Next
                    X.Offset(0, 1) = ""
                    X.Offset(0, 1) = Now
                    X.Offset(0, 1).NumberFormat = "dd-mm-yyyy HH:mm"
                End If
            End If
        End If
    Next
    Application.EnableEvents = True
End Sub

 

[ehabaf2]

الف الف شكر لحضراتكم جميعا الاخوة الافاضل 

ربنا يحفظكم و يزيدكم علما و يجعل كل علمكم فى ميزان حسناتكم

الحمد لله الملف يعمل كما اريد اكرر شكرى لحضراتكم