حذف الفراغات داخل الجملة وجمع قيمة الحروف

[حمور]

الأخوة في المنتدى

قسم الاكسس بالتحديد

السلام عليكم ورحمة الله

لدي سؤال ارجو الافادة بالسرعة الممكنة لو تكرمتم اخوكم جديد في المنتدى

اريد دالة لعمل الاتي

1. لدي مثلا جدول به مجموعة من الثوابت حيث أن مثلا أ = 1، ب = 5 ، ج = 10 ، د = 15 هـ = 20

عندما أكتب في مربع النص مثلا كلمة مكونة من مجموعة من الحروف مثلا كلمة أبها = أ + ب + هـ + أ تساوي 1 +5+20+1 = الناتج النهائي = 27 وخانة أخرى يكون به عدد الحروف أي تكرارها في الكلمة

أ 2 ب 1 ه 1 مرة

شارك لكم يا معلمين

[ابوخليل]

ارفق مثالك للتطبيق

[حمور]

ارفق مثالك للتطبيق

برنامج لحساب الجمل الصغير والجمل الكبير لسور القرآن الكريم

تدخل الآية الناتج عدد الحروف = ؟ المكرر من الحروف = ؟ الحساب بالجمل الصغير + ؟ وذلك على ضوء الآتي

أ= 1 ب + 2 ج =3 د = 4 هـ = 5 ل = 10 م = 20 وهكذا ألخ الحروف والجمل الصغير

مثلا كلمة الم عدد الحروف 3 حروف الحساب بالجمل الصغير حاصل جمع الاف 1 اللام 10 الميم 20 = 1 + 10 +20 = 31

ام الجمل الكبير يعني الألف = ألف = (أ + ل + ف ) + الميم (م + ي + م)+ لام (ل + أ + م) والناتج بعد الجمع = 150 وهكذا

شاكر جدا لك يا خي على المشاركة والاهتمام

[ابوخليل]

أرى أن المسألة ليست بالسهولة التي قدرتها

ارفق جدول الثوابت الذي لديك

فلن نعدم مساعدا ومساندا من اخواني

[حمور]

أخي ابو خليل ليست لدي صلاحية ارفاق ملف

ولكن جدول به 28 حرف من أ- غ كل الحروف مقابل لها قيمة كل حرف

هنالك مربع نص اكتب به اي كلمة الناتج يتم حسابه في مربع نص آخر وذلك بجمع قيم حروف هذه الكلمة وكل حرف له قيمة مقابله له

ثانيا مثلا عدد حروف كلمة خليل 4 حروف يتم تفصيلها كالاتي حيث ان حرف ال خ ورد مرة و الـ ل مرتين و حرف الـ ي مرة واحدة

[ابوخليل]

تقصد من ليس لك صلاحية انك لم تستطع ؟

اذا كان كذلك فقم بضغط الملف قبل ارفاقه بأحد برامج الضغط winrar or winzip

ايضا : الجمع معروف وأمره ميسور بإذن الله

ولكن عدد ورود الحرف في الجملة لا اعلم كيف تريد ظهوره ؟ هل تريد ان تظهر الحروف كلها وتجعل امام كل حرف عدد تكرار وروده في الجملة ؟ ام تريد الحروف المكررة فقط وعدد تكرارها ؟

تم تعديل يوليو 20, 2011 بواسطه أبو خليل

[حمور]

مرحبا أبو خليل يعطيك العافية

مثلا الـ 28 حرف تقسم إلى اربعة مجموعات المجموعة A بها سبعة حروف (أ،ب،ج،د،هـ،و،ز) والمجموعة B بها سبعة أحرف (ح،ط،ي،ك،ل،م،ن)والمجموعة C بها سبعة(س‘ع،ف،ص،ق،ر،ش) والمجموعة D بهاسبعة (ت ،ث،خ،ذ،ض،ظ،غ)مثلا عندنا كلمة ايمن عدد حروف المجموعة A عدد الحروف 1 يعني الاف من كلمة ايمن المجموعة B بها 3 حروف م ي ن المجموعة C صفر أي زيرو المجموعة D ايضا صفر يعني الحروف لكل مجموعة وعددهم

علي العموم رسل لي مبدئيا دالة الجمع

مشكور أخوي أبو خليل ما عدمناك

[ابوخليل]

دالة الجمع ستعتمد على القيم في جدول الثوابت

وتكون كهذه :

Dim m

    Text2 = 0

    For m = 1 To Len(Text1)

        Text2 = Text2 + DLookup("num", "tbl1", "tex = '" & Mid(Text1, m, 1) & "'")

    Next m

[حمور]

مشكور يا حبيب يا ريت نتعرف عليك اكثر نعم الاخ

وكان عندك اي شيء في قطر انا حاضر

كان الله في عونك

[ابوخليل]

انت تقوم بعمل وخدمة شي عزيز علينا ، فخدمتك واجبة

ايضا اخواني هنا يبذلون ويعطون من انفسهم بلا حساب

دعواتك لعامة أهل المنتدى ،،،

[حمور]

مرحبا أبو خليل يعطيك العافية

دالة الجمع اشتغلت عليها 100% جزاك الله خير باقي الجزء الثاني وهو

مثلا الـ 28 حرف تقسم إلى اربعة مجموعات المجموعة A بها سبعة حروف (أ،ب،ج،د،هـ،و،ز) والمجموعة B بها سبعة أحرف (ح،ط،ي،ك،ل،م،ن)والمجموعة C بها سبعة(س‘ع،ف،ص،ق،ر،ش) والمجموعة D بهاسبعة (ت ،ث،خ،ذ،ض،ظ،غ)مثلا عندنا كلمة ايمن عدد حروف المجموعة A عدد الحروف 1 يعني الاف من كلمة ايمن المجموعة B بها 3 حروف م ي ن المجموعة C صفر أي زيرو المجموعة D ايضا صفر يعني الحروف لكل مجموعة وعددهم

علي العموم رسل لي مبدئيا دالة الجمع

مشكور أخوي أبو خليل ما عدمناك

[حمور]

دالة الجمع ستعتمد على القيم في جدول الثوابت

وتكون كهذه :

Dim m

    Text2 = 0

    For m = 1 To Len(Text1)

        Text2 = Text2 + DLookup("num", "tbl1", "tex = '" & Mid(Text1, m, 1) & "'")

    Next m

ابو خليل

بس المشكلة في الدالة تبع الجمع إلا أدخل النص من دون مسافات ما هو الحل

[ابوخليل]

الدالة trim خاصة بإزالة المسافاتالفارغة ولكن ما قبل وما بعد النص

اما في وسط الجملة فاعتقد اننا بحاجة الى وحدة نمطية او اثنتان لحذف الفراغات .

ونحتاج الى مثال بسيط للتطبيق .

الأمر يسير ومقدور عليه بإذن الله

ولكن لا ندري قد يتحفنا اساتذتنا بشيء مختصر وجديد

[ابوخليل]

هذه الأوامر ستقوم بالمهمة ، الصقها في صفحة الفورم

وقم بانشاء مربع نص text3 مخفي

هذه الوحدات النمطية استللتها من مشاركة للأخ الاستاذ ابو حمود غفر الله له ولوالديه .

Private Function NeatSplit(ByVal Expression As String, _

Optional ByVal Delimiter As String = " ", _

Optional ByVal Limit As Long = -1, _

Optional Compare As VbCompareMethod = vbBinaryCompare) _

As Variant

Dim varItems As Variant, i As Long

varItems = Split(Expression, Delimiter, Limit, Compare)

For i = LBound(varItems) To UBound(varItems)

If Len(varItems(i)) = 0 Then varItems(i) = Delimiter

Next i

NeatSplit = VBA.Strings.Filter(varItems, Delimiter, False)

End Function

Function sReplace(SearchLine As String, SearchFor As String, ReplaceWith As String)

Dim vSearchLine As String, found As Integer

Dim Swords

found = InStr(SearchLine, SearchFor)

vSearchLine = SearchLine

If found <> 0 Then

vSearchLine = ""

If found > 1 Then vSearchLine = Left(SearchLine, found - 1)

vSearchLine = vSearchLine + ReplaceWith

If found + Len(SearchFor) - 1 < Len(SearchLine) Then _

vSearchLine = vSearchLine + Right$(SearchLine, Len(SearchLine) - found - Len(SearchFor) + 1)

End If

found = InStr(vSearchLine, SearchFor)

Swords = vSearchLine

Do While found <> 0

vSearchLine = Left(vSearchLine, found - 1)

vSearchLine = vSearchLine + ReplaceWith

vSearchLine = vSearchLine + Right$(Swords, Len(Swords) - found - Len(SearchFor) + 1)

found = InStr(vSearchLine, SearchFor)

Swords = vSearchLine

Loop

sReplace = vSearchLine

End Function

Private Sub Text1_AfterUpdate()

Dim x As Variant

x = NeatSplit(sReplace([Text1], " ", ""))

For i = LBound(x) To UBound(x)

Text3 = x(i)

Next i

End Sub

Private Sub Command6_Click()

Text1.Requery

If Not IsNull(Text3) Then

    Dim m

    Text2 = 0

    For m = 1 To Len(Text3)

        Text2 = Text2 + DLookup("num", "AbjadHawwaz", "tex = '" & Mid(Text3, m, 1) & "'")

    Next m

End If

End Sub

[حمور]

مشكور ابو خليل

هنالك مشكلة في هذا السطر توجد علامات إستفهام به

ماعلاقة الـtext3 بالموضوع

vSearchLine = vSearchLine + Right$(C????E, Len(Swords) - found - Len(SearchFor) + 1)

[ابوخليل]

تم تعديل السطر أعلاه

الوحدة النمطية تنقل النص من text1 وتضعه في text3 بدون مسافات

وعمليات الجمع تتم استنادا الى text3

[حمور]

تم تعديل السطر أعلاه

الوحدة النمطية تنقل النص من text1 وتضعه في text3 بدون مسافات

وعمليات الجمع تتم استنادا الى text3

اخي ابو خليل الوحدة النمطية ما اشتغلت معاي

[ابوخليل]

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

اليك تطبيقا لما تم عرضه

حذف الفراغات وجمع الحروف.rar

[حمور]

الاخ ابو خليل جزاك الله خيرا وكل سنة وانت وأعضاء المنتدى طيبين

والبرنامج تم على أكمل وجه وذلك لجهودكم المقدرة

شاكرين