تحويل الكود الي دالة

[أبو صاصا]

رجاءا تحويل هذا الكود لمعادلة

 

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

     If Not Intersect(Target, Range("c7:c10000")) Is Nothing Then

      VBA.Calendar = vbCalGreg

      If IsEmpty(Target) Then

         Target(1, 2).ClearContents

    Else

         With Target(1, 4)

               .Value = Date

               .EntireColumn.AutoFit

           End With

       End If

End If

If Not Intersect(Target, Range("d:d")) Is Nothing Then

     If Target.Offset(0, 1) = "" Or Not IsNumeric(Target.Offset(0, 1).Value) Then

         Cells(Target.Row, 6) = Date

     End If

End If

End Sub