كود الكتابة في خلية والتجميع في خلية لا يعترف بما وراء الفاصلة ممكن تعديله

[aspiran]

السلام عليكم أحبتي أعضاء و رواد المنتدى ....... زملائي ممكن تعديل الكود و هو لأحد الزملاء بالمنتدى لكنه لا يعترف بما وراء الفاصلة حيث يجمع إلا الأعداد الطبيعية جزاكم الله خيرا 

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      Static dAccumulator As Double
      With Target
         If .Address(False, False) = "A1" Then
            If Not IsEmpty(.Value) And IsNumeric(.Value) Then
               dAccumulator = dAccumulator + .Value
            Else
               dAccumulator = 0
            End If
            Application.EnableEvents = False
            .Value = dAccumulator
            .Select
            Application.EnableEvents = True
         End If
      End With
End Sub

 

[سليم حاصبيا]

جرب هذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$A$1" Then
 Dim New_val, Old_val
  New_val = Target.Value
   If Not IsNumeric(New_val) Then New_val = 0
  Application.Undo
  Old_val = Target.Value
  Target.Value = New_val + Old_val
End If
Application.EnableEvents = True
End Sub

 

[aspiran]

جزاك الله خيرا أستاد سليم حاصبيا   جاري التجريب