اذهب الي المحتوي
أوفيسنا

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


shoaip
إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

  • أفضل إجابة

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

  • Like 2
رابط هذا التعليق
شارك

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

  • Like 3
رابط هذا التعليق
شارك

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

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

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

  • Like 4
رابط هذا التعليق
شارك

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

تسويات - Copy.xlsx

رابط هذا التعليق
شارك

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

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

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

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

Screenshot_1.png

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

Taswiyat_formula.xlsm

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information