تحويل الدالة counta الى كود vba

[كريم جودي]

السلام عليكم اريد ان احول دالة  counta الى كود vba  مع التكرار  بحيث حاولت استعمال التكرار  ولكنني لم اوفق

فأريد من اهل الخبرة المساعدة

counta in vba.rar

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

جرب هذا الكود

Sub Salim()

For i = 3 To 10
Cells(i, "l") = Evaluate("COUNTA(D" & i & ":k" & i & ")")
Next

End Sub

 

[كريم جودي]

شكرا لك اخي سليم فقط لو بالامكان تكون الدالة اتوماتيكية

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

3 ساعات مضت, كريم جودي said:

شكرا لك اخي سليم فقط لو بالامكان تكون الدالة اتوماتيكية

هذا الكود 

يوضع في حدث الصفحة (حدد الصفحة المطلوب العمل فيها من VBa editor بواسطة دوبل كليك) ثم انسخ الكود  

كي يعمل الكود يجب ان يكون عامود A مرقماً بشكل صحيح

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Integer
Application.EnableEvents = False
lr = Application.Max(Range("a:a")) + 2
        If Not Intersect(Target, Range("D3:k" & lr)) Is Nothing And Target.Count = 1 Then
          Cells(Target.Row, "l") = Evaluate("COUNTA(D" & Target.Row & ":k" & Target.Row & ")")
        End If
  Application.EnableEvents = True
End Sub

 

تم تعديل مارس 8, 2017 بواسطه سليم حاصبيا

[كريم جودي]

شكرا لك اخي سليم الحل ناجح ولكن أريد ان اتعلم بجعل الدالة تكرارية

Cells(3, "l") = Application.CountA([d3:k3])

[كريم جودي]

7 ساعات مضت, سليم حاصبيا said:

هذا الكود 

يوضع في حدث الصفحة (حدد الصفحة المطلوب العمل فيها من VBa editor بواسطة دوبل كليك) ثم انسخ الكود  

كي يعمل الكود يجب ان يكون عامود A مرقماً بشكل صحيح

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Integer
Application.EnableEvents = False
lr = Application.Max(Range("a:a")) + 2
        If Not Intersect(Target, Range("D3:k" & lr)) Is Nothing And Target.Count = 1 Then
          Cells(Target.Row, "l") = Evaluate("COUNTA(D" & Target.Row & ":k" & Target.Row & ")")
        End If
  Application.EnableEvents = True
End Sub

 

لو بالامكان ان تجعل الكود مستقل عن العمود Aفقط بdالى k

7 ساعات مضت, سليم حاصبيا said:

هذا الكود 

يوضع في حدث الصفحة (حدد الصفحة المطلوب العمل فيها من VBa editor بواسطة دوبل كليك) ثم انسخ الكود  

كي يعمل الكود يجب ان يكون عامود A مرقماً بشكل صحيح

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Integer
Application.EnableEvents = False
lr = Application.Max(Range("a:a")) + 2
        If Not Intersect(Target, Range("D3:k" & lr)) Is Nothing And Target.Count = 1 Then
          Cells(Target.Row, "l") = Evaluate("COUNTA(D" & Target.Row & ":k" & Target.Row & ")")
        End If
  Application.EnableEvents = True
End Sub

 

لو بالامكان ان تجعل الكود مستقل عن العمود Aفقط بdالى k

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

هذا كود جديد مختلف   ( مستقل عن العمود A)

Sub Salim1()
my_max = 0
  For i = 4 To 11
     lr = Sheets("Feuil1").Cells(Rows.Count, i).End(3).Row
     If lr >= my_max And lr > 2 Then my_max = lr
     Next
   If my_max = 0 Then Exit Sub
     For m = 3 To my_max
    Cells(m, "L").Formula = "=COUNTA(D" & m & ":K" & m & ")"
     Cells(m, "L").Value = Cells(m, "L").Value
     Next
End Sub

 

تم تعديل مارس 8, 2017 بواسطه سليم حاصبيا

[كريم جودي]

18 ساعات مضت, سليم حاصبيا said:

هذا الكود 

يوضع في حدث الصفحة (حدد الصفحة المطلوب العمل فيها من VBa editor بواسطة دوبل كليك) ثم انسخ الكود  

كي يعمل الكود يجب ان يكون عامود A مرقماً بشكل صحيح

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Integer
Application.EnableEvents = False
lr = Application.Max(Range("a:a")) + 2
        If Not Intersect(Target, Range("D3:k" & lr)) Is Nothing And Target.Count = 1 Then
          Cells(Target.Row, "l") = Evaluate("COUNTA(D" & Target.Row & ":k" & Target.Row & ")")
        End If
  Application.EnableEvents = True
End Sub

 

لو بالامكان ان تجعل الكود مستقل عن العمود Aفقط بdالى k

شكرا لكم اخي سليم وبارك الله فيكم وفي المنتدى