معادلة عد الأرقام داخل الخلية

[shoaip]

أريد ايضا معادله جمع المبالغ يعني ارقام في خليه واحده مثل 10+20+30+50 الخليه الأخرى يطلع فيها عدد المبالغ وهو 4 وهكذا

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

1-لقد تم تنبيهك الى وجوب رفع ملف فيه الشرح الكافي
2- حبث انك عضو جدبد في المنتدى فأهلاً وسهلاً بك
3-لكن في المرة المقبلة سوف تحذف اي مشاركة بدون ملف مرفق

جرب هذا الكود

Option Explicit

      Rem code for Extact Number_From_Text
      Rem Created By Salim Hasbaya On 14/11/2020
Sub Extract_Number_From_Text()
    Dim rgx As Object
    Dim My_Number As Object
    Dim ws As Worksheet
    Dim i%, m%, k%, x%, Ro%
    
    Set rgx = CreateObject("VBScript.RegExp")
    Set ws = Worksheets("Salim")
       
    Ro = ws.Cells(Rows.Count, 1).End(3).Row
    With ws.Range("C1").Resize(Ro, 20)
        .ClearContents
        .Interior.ColorIndex = xlNone
        End With
    m = 1: k = 4
    
    With rgx
       .Global = True: .Pattern = "(\d+)"
           For i = 1 To Ro
              If .test(ws.Cells(i, 1)) Then
                Set My_Number = .Execute(ws.Cells(i, 1))
                 ws.Cells(m, 3) = My_Number.Count & " Numbers"
                 ws.Cells(m, 3).Interior.ColorIndex = 6
                  For x = 0 To My_Number.Count - 1
                    ws.Cells(m, k).Offset(, x) = Val(My_Number.Item(x))
                  Next x
            End If
              m = m + 1
        Next i
  End With

End Sub

الملف مرفق    فقط اضغط الزر Run Please

 

Extract_Number_From_Text.xlsm

[shoaip]

تسويات.xlsx

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

ماذا تريد من الجدول الفارغ الذي رفعته

رجاء املأه بيانات والتنائج التي تتوقعها (يمكن يدوياً ريثما نجد ما تريد ان يقوم به البرنامج اوتوماتيكياً)

[Ali Mohamed Ali]

كان عليك تنفيذ نصيحة استاذنا الكبير سليم .. ولكن بعد اذن استاذ سليم طبعاً يمكنك استخدام هذه الدالة المعرفة لذلك لعد الأرقام داخل الخلية الواحدة

Function Mylen(Z As Range)
Dim C As Long, Y As Long, A As Long, B As Variant
    A = 0
    For C = 1 To Len(Z)
        B = Mid(Z, C, 1)
            For Y = 0 To 9
                If Y = B Then
                    A = A + 1
                End If
            Next
    Next
    Mylen = A
End Function

ووضع هذه المعادلة بداية من الخلية D4 سحباً للأسفل

=Mylen(F4)

أو يمكنك بهذه المعادلة العادية .. وتلك الطريقتين موجودة بالملف

=SUM(LEN(F4)-LEN(SUBSTITUTE(F4,{1,2,3,4,5,6,7,8,9,0},)))

تسويات - 1.xlsm

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

بارك الله بك اخي علي

ولاثراء الموضوع هذا الكود (بعمل في حال وجود فواصل عشرية  "." ولا يتعاطى مع ما يوجد بين  الارفام / +/ -  /نصوص الخ....)

Option Explicit
Sub Extract_Number()
    Dim rgx As Object
    Dim My_Number As Object
    Dim ws As Worksheet
    Dim i%, x%, Ro%, My_Sum#
  
    Set rgx = CreateObject("VBScript.RegExp")
    Set ws = Worksheets("Sheet1")
       
    Ro = ws.Cells(Rows.Count, "F").End(3).Row
    ws.Range("D4").Resize(15, 2).ClearContents
  
With rgx
    .Global = True: .Pattern = "(\d+\.?\d+)"
     For i = 4 To Ro
       My_Sum = 0
      If .test(ws.Cells(i, "F")) Then
        Set My_Number = .Execute(ws.Cells(i, "F"))
        ws.Cells(i, 5) = My_Number.Count
          For x = 0 To My_Number.Count - 1
           My_Sum = My_Sum + Val(My_Number.Item(x))
          Next x
      End If
       Cells(i, 4) = My_Sum
    Next i
End With

End Sub

الملف مرفق

Taswiyat.xlsm

[shoaip]

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

تسويات - Copy.xlsx

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

2 ساعات مضت, shoaip said:

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

تسويات - Copy.xlsx 16.2 kB · 2 downloads

يجب حفظ الملف بصيغة  xlsm لا بصيغة xlsx كما هو موضح بالصورة

ملف احر مرفق مع معادلة( ايضاً يجب حفظه الملف بصيغة  xlsm)

Taswiyat_formula.xlsm