المطلوب دالة لحساب عدد الارقام بخلية واحدة

[Abuelkhasem]

السلام عليكم

لدي خلية اكسل بها القيم التالية (  65,84,412,65,84,110)  ، و المطلوب حساب عدد الارقام و ليس مجموعها و المكرر يحسب مرة واحده فقط
يعني النتيجه =4

ملاحظة : يمكن وضع الارقام بصيغة نص
و شكراً

[جمال عبد السميع]

عفوا أخى بعد رؤية مرفق أستاذى الرائع وكودة الرائع ( رجب جاويش )

إتضح لى أن المعادلة ليست دقيقة بعد تجربتها لتعطى نفس نتيجة أستاذى ( رجب جاويش )

لذلك تم تعديل المرفق والأن أصبح كل شئ تمام

تقبل تحياتى

عدد الأرقام المفردة داخل خلية.rar

تم تعديل يناير 4, 2014 بواسطه جمال عبد السميع

[رجب جاويش]

بالإضافة الى حل أخى الحبيب / محمود

هذا كود يقوم بعمل المطلوب

Sub ragab()
Range("B2:B1000").ClearContents
For x = 2 To [A1000].End(xlUp).Row
    For xx = 1 To UBound(Split(Cells(x, 1), ",")) + 1
        d = Split(Cells(x, 1), ",")(xx - 1)
        T = Application.WorksheetFunction.CountIf(Range(Cells(1, 30), Cells(xx, 30)), d)
        If T < 1 Then
            Cells(xx, 30) = d
            myCount = myCount + 1
        End If
    Next
    Cells(x, 2) = myCount
    Range(Cells(1, 30), Cells(xx, 30)) = ""
    myCount = 0
Next
End Sub

عدد الأرقام الفريدة.rar

[محمد ابو البـراء]

رائع ....

كم سعادتي بين اثنين من عمالقة المنتدى

ملك المعادلات / استاذ جمال

وصاحب الاكواد البسيطة المميزة استاذي ومعلمي /استاذ رجب جاويش

جزاكما الله خيراً :fff: :fff:

[عبدالله باقشير]

السلام عليكم

 

الشكر واصل لخي الجبيب جمال واخي الحبيب رجب ..........حفظهما الله

 

لاثراء الموضوع هذه دالة بالكود

Option Explicit

Function kh_vCont(iText) As Long
Dim Obj As Object, Tx
'''''''''''''''''''''''''''''
Set Obj = CreateObject("Scripting.Dictionary")
'''''''''''''''''''''''''''''
For Each Tx In Split(iText, ",")
    If Not Obj.Exists(Trim(Tx)) Then
        Obj.Add Trim(Tx), 1
    End If
Next
kh_vCont = Obj.Count
Set Obj = Nothing
End Function

المرفق 2003

دالة عدد الأرقام الفريدة في نص.rar

[رجب جاويش]

أستاذى الحبيب / عبد الله باقشير

سلمت يمناك وسلمت أفكارك ليتعلم منها الجميع

[عبدالله باقشير]

أستاذى الحبيب / عبد الله باقشير

سلمت يمناك وسلمت أفكارك ليتعلم منها الجميع

جزاكم الله خيرا

تقبلوا تحياتي وشكري

[Abuelkhasem]

شكرا لكم على المجهود و على الاجابة ،،، ساقوم بالتحميل و التجربة على ملفاتي و ابلغكم بالنتيجه

[Abuelkhasem]

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

[جمال عبد السميع]

بصراحة أخى الطلب غير واضح ياريت ترفق مثال على الكيفية التى تريد بها طلبك هذا

[Abuelkhasem]

example.rarالمطلوب ان يتم عد الارقام في الثلاث خلايا معاً مع عد المكرر مرة واحده.
او بالأحرى عد الارقام لشيت كامل

[عبدالله باقشير]

example.rarالمطلوب ان يتم عد الارقام في الثلاث خلايا معاً مع عد المكرر مرة واحده.

او بالأحرى عد الارقام لشيت كامل

هذه الدالة تقوم بذلك

Option Explicit


Function kh_vCont11(Rng As Range) As Long
Dim Col As New Collection
Dim Tx, iText, v
'''''''''''''''''''''''''''''
On Error Resume Next
For Each v In Rng.Cells
    For Each Tx In Split(CStr(v), ",")
        Col.Add 1, Trim(Tx)
    Next
Next
kh_vCont11 = Col.Count
Set Col = Nothing
On Error GoTo 0
End Function

شاهد المرفق 2003

example++.rar

[Abuelkhasem]

مشكور جداً استاذ عبدالله ،، و الشكر موصول للمنتدى و القائمين عليه