ياسر خليل أبو البراء قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 جرب التعديل بهذا الشكل Function CalcString(S As String) Dim ArrLetters, ArrValues, X() As Byte, SpaceCounter As Long Dim I As Long, Counter As Long, Pos& ArrLetters = Join(Array("أ", "ا", "إ", "ب", "ت", "ث", "ج", "ح", "خ", "د", "ذ", "ر", "ز", "س", "ش", "ص", "ض", "ط", "ظ", "ع", "غ", "ف", "ق", "ك", "ل", "م", "ن", "ه", "ة", "و", "ي")) ArrValues = Array(1, 1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 26, 27, 28) X = StrConv(S, vbFromUnicode) For I = 0 To UBound(X) Pos = InStr(ArrLetters, Chr(X(I))) If Pos > 0 Then Counter = Counter + ArrValues((Pos - 1) / 2) Next I On Error Resume Next SpaceCounter = SpaceCount(S) If SpaceCounter = 0 Then CalcString = Counter Else CalcString = Counter - SpaceCounter End If End Function Function SpaceCount(ByVal strLine As String) As String Dim Str As String Dim TempCount As Long Dim I As Long Str = Trim(strLine) TempCount = 0 For I = 1 To Len(Str) If Mid(Str, I, 1) = " " Then TempCount = TempCount + 1 Else If TempCount > 0 Then SpaceCount = SpaceCount & " " & TempCount TempCount = 0 End If End If Next I SpaceCount = Mid(SpaceCount, 2) End Function 3
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 شكرا لك المهندس ابو البراء قمت بنسخ ولصق الكود لم يكتب في النتيجة value ما سبق لكن كل ما اكتبه تظهر النتيجة صفر
ياسر خليل أبو البراء قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 الكود يعمل بشكل جيد معي جرب الملف المرفق لربما حدث خطأ أثناء النسخ واللصق Sum Letters YasserKhalil V2.rar
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 الكود يعمل بشكل جيد معي جرب الملف المرفق لربما حدث خطأ أثناء النسخ واللصق Sum Letters YasserKhalil V2.rar مشكور عزيزي والله تعبتك معاي باركك الله في علمك وعملك ونفعك بك وحفظك من كل شر قمت بتغيير واجهة الاكسل من الانجليزية للعربية ولكن دون جدوى لما فتحته وكتبت كلمات اخرى نفس المشكلة النتيجة صفر لا عليك سيدي المشكلة ربما من جهازي وليست في الدالة او الملف المرفق 1
ياسر خليل أبو البراء قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 أخي الكريم لا علاقة بواجهة الإكسيل ..أنا أعمل على نسخة أوفيس 2013 الإنجليزية وليست العربية وتعمل معي الدالة بكفاءة ما هي نسخة الأوفيس لديك؟ هل هناك أي مشاكل بنسخة الأوفيس؟ لا تيأس وكرر المحاولة ويرجى من الأخوة ممن جربوا الملف أن يوافونا بعمل الملف من عدمه معهم ..
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 المهندس ابو البراء اكتشفت الخطأ لكن لا اعرف ما هو تصحيحه يعني لما اكتب مثلا بسم الله الرحمن الرحيم يحسب الفراغات بين الكلمات حيث كتب في النتيجة 3 ولما اكتب كلمة واحدة لا يعطيني شيء وكذلك لما كتبت كلمتين حسب الفراغ فقط واعطاني نتيحة 1 حيث ان الفراغ بين الكلمتين واحدhttp://dc20.arabsh.com/uploads/image/2015/10/02/0c3e424e66fa07.jpg اي انه لا يحسب الحروف كما أنا أريده وكما برمجته سيادتك فما هو الحل لهذه المشكلة أخي الكريم لا علاقة بواجهة الإكسيل ..أنا أعمل على نسخة أوفيس 2013 الإنجليزية وليست العربية وتعمل معي الدالة بكفاءة ما هي نسخة الأوفيس لديك؟ هل هناك أي مشاكل بنسخة الأوفيس؟ لا تيأس وكرر المحاولة ويرجى من الأخوة ممن جربوا الملف أن يوافونا بعمل الملف من عدمه معهم .. نسخة الاوفيس لدي 2013 الانجليزية ليست لدي مشاكل بنسخة الاوفيس اطلاقا
ياسر خليل أبو البراء قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 الملف يعمل معي بدون أي مشكلة وبنتائج صحيحة ننتظر رأي الأخوة الذين جربوا الملف للتأكد من صحة الكود .. وسأحاول أن أقدم دالة أخرى ..
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 الملف يعمل معي بدون أي مشكلة وبنتائج صحيحة ننتظر رأي الأخوة الذين جربوا الملف للتأكد من صحة الكود .. وسأحاول أن أقدم دالة أخرى .. شكرا لك سيدنا العزيز ومهندسنا الجليل بارك الله فيك وفي عمرك واسف على اني اتعبتك معاي
ياسر خليل أبو البراء قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 جرب الدالة التالية Function YK(sInp As String) As Long Static bInit As Boolean Dim asMap() As String Dim asLtr() As String Dim I As Long Static aiVal(0 To 255) As Long If Not bInit Then asMap = Split("1 1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 26 27 28") asLtr = Split("أ ا إ ب ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن ه ة و ي") For I = 0 To UBound(asMap) aiVal(Asc(asLtr(I))) = asMap(I) Next I bInit = True End If For I = 1 To Len(sInp) YK = YK + aiVal(Asc(Mid(sInp, I, 1))) Next I End Function Sum Letters YasserKhalil V3.rar 3
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 (معدل) نجحت والحمد لله اولا واخيرا نجحت والحمد لله اولا واخيرا نجحت والحمد لله اولا واخيرا وشكرا لك يا مبدع يا مهندس الابداع يا ابو براء يا ابوالهندسة كلها حماك الله في حلك وترحالك وفي مشيك ونومك ويقظتك وعفا عنك وغفر لك ولوالديك ووسع عليك واعطاك ما تتمنى في الدنيا والاخرة "اشتغلت الدالة " تم تعديل أكتوبر 2, 2015 بواسطه westexcel تعديل 4
ياسر خليل أبو البراء قام بنشر أكتوبر 2, 2015 قام بنشر أكتوبر 2, 2015 الحمد لله الذي بنعمته تتم الصالحات جزيت خيراً على دعواتك الطيبة تقبل تحياتي
رمهان قام بنشر أكتوبر 3, 2015 قام بنشر أكتوبر 3, 2015 ماشاء الله عليك استاذ ياسر والى الامام جميل جدا فكرتك استاذ سليم هذه محاولة بسيطة وللاثراء والافادة ! ومغازلة الكبار! Function ramhan(xinput As String) As Integer xinput = Replace(xinput, "أ", "ا") xinput = Replace(xinput, "إ", "ا") xinput = Replace(xinput, "ة", "ه") Dim xletters As String, i As Integer, xsum As Integer xletters = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي" For i = 1 To Len(xinput) xsum = xsum + InStr(1, xletters, mid(xinput, i, 1)) Next i ramhan = xsum End Function تحياتي للجميع 4
محمد حسن المحمد قام بنشر أكتوبر 3, 2015 الكاتب قام بنشر أكتوبر 3, 2015 نجحت والحمد لله اولا واخيرا نجحت والحمد لله اولا واخيرا نجحت والحمد لله اولا واخيرا وشكرا لك يا مبدع يا مهندس الابداع يا ابو براء يا ابوالهندسة كلها حماك الله في حلك وترحالك وفي مشيك ونومك ويقظتك وعفا عنك وغفر لك ولوالديك ووسع عليك واعطاك ما تتمنى في الدنيا والاخرة "اشتغلت الدالة " السلام عليكم أخي قلم الإكسل ...دعاء طيب لا أحسد أخي أبو البراء عليه ولكنني أرجو أن ينالنا شيء منه... فالدال على الخير كفاعله.............تقبل تحياتي.. جرب الدالة التالية Function YK(sInp As String) As Long Static bInit As Boolean Dim asMap() As String Dim asLtr() As String Dim I As Long Static aiVal(0 To 255) As Long If Not bInit Then asMap = Split("1 1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 26 27 28") asLtr = Split("أ ا إ ب ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن ه ة و ي") For I = 0 To UBound(asMap) aiVal(Asc(asLtr(I))) = asMap(I) Next I bInit = True End If For I = 1 To Len(sInp) YK = YK + aiVal(Asc(Mid(sInp, I, 1))) Next I End Function Sum Letters YasserKhalil V3.rar السلام عليكم أخي أبو البراء الحبيب...أعتقد أن دوالك وأكوادك لا تخضع للتجريب كونها من مصدر ثقة ووعي ودراسة وإتقان...جزاكم الله خيراً... والحمد لله أن روح الدعابة وألقها بدا من خلال قبعتك التي لم ترفعها....ذلك يدعني أقول زاح شرك وزال همك وطاب عيشك بإذن الله...المحب لكم. 2
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 3, 2015 قام بنشر أكتوبر 3, 2015 السلام عليكم أخي قلم الإكسل ...دعاء طيب لا أحسد أخي أبو البراء عليه ولكنني أرجو أن ينالنا شيء منه... فالدال على الخير كفاعله.............تقبل تحياتي.. شكرا لك استاذي العزيز فعلا لو الله ثم انت بتوجيه رسالتي الى هنا ربما لن تحصل الفائدة الكبرى من مهندس المبدعين ابو البراء حفظه الله وبارك له في حياته واعدو الله ان يجعلك مساعدا للمساكين مثلي ويرحم بك عباده ويبارك لك في رزقك وعمرك ويمنحك الصحة الابدية والحفظ الازلي من كل شر شكرا مرة اخرى لمهندسنا الغالي ابو البراء والله يوفقك في كل امورك ويسهل عليك حاجتك وتقضى بمجرد التفكر فيها ونلتقي في موضوع اخر 2
ياسر خليل أبو البراء قام بنشر أكتوبر 3, 2015 قام بنشر أكتوبر 3, 2015 أبي الحبيب أبو يوسف دائماً ما تتفوق علينا بكلماتك الرقيقة الطيبة ..بارك الله فيك وجزيت خير الجزاء أخي الحبيب المتميز المغازل رمهان بصراحة أحلى غزل وأحلى دالة في الموضوع ..مشكور على المشاركة بهذه الدالة المميزة الأخ الكريم قلم الإكسيل الحمد لله أن تم المطلوب على خير ونورت المنتدى بين إخوانك وننتظر منك التواجد بيننا لنستفيد منك وتستفيد منا تقبلوا تحياتي 2
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 3, 2015 قام بنشر أكتوبر 3, 2015 ماشاء الله عليك استاذ ياسر والى الامام جميل جدا فكرتك استاذ سليم هذه محاولة بسيطة وللاثراء والافادة ! ومغازلة الكبار! Function ramhan(xinput As String) As Integer xinput = Replace(xinput, "أ", "ا") xinput = Replace(xinput, "إ", "ا") xinput = Replace(xinput, "ة", "ه") Dim xletters As String, i As Integer, xsum As Integer xletters = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي" For i = 1 To Len(xinput) xsum = xsum + InStr(1, xletters, mid(xinput, i, 1)) Next i ramhan = xsum End Function تحياتي للجميع كمعلومة يا مهندس رمهان لما مثلا اكتب في الخلية d2: كلمة الله d3: النتيجة في d3 ما هي المعادلة التي اكتبها كي استطيع مشاهدة النتيجة يعني d3 معتمدة على المكتوب في d2 لكن ما هي المعادلة التي سأكتبها في d3 كي تظهر النتيجة وشكرا مع انه المهندس ابو البراء حفظه الله من كل سوء ما قصر في الموضوع لكن فقط كمعلومة نأخذها لأن الدالة التي شرحتها مختلفة عن ابو البراء
قلم-الاكسل(عبدالعزيز) قام بنشر أكتوبر 3, 2015 قام بنشر أكتوبر 3, 2015 =ramhan(d2) شكرا لك استاذي الجليل وبارك لك في عمرك والى الامام لا تنسانا من مواضيعك القيمة 1
رمهان قام بنشر أكتوبر 3, 2015 قام بنشر أكتوبر 3, 2015 أبي الحبيب أبو يوسف دائماً ما تتفوق علينا بكلماتك الرقيقة الطيبة ..بارك الله فيك وجزيت خير الجزاء أخي الحبيب المتميز المغازل رمهان بصراحة أحلى غزل وأحلى دالة في الموضوع ..مشكور على المشاركة بهذه الدالة المميزة الأخ الكريم قلم الإكسيل الحمد لله أن تم المطلوب على خير ونورت المنتدى بين إخوانك وننتظر منك التواجد بيننا لنستفيد منك وتستفيد منا تقبلوا تحياتي كلامك ومرورك شرف واعجابك وسام وما نحن الا قطره في بحر علمكم 1
عبد العزيز البسكري قام بنشر أكتوبر 3, 2015 قام بنشر أكتوبر 3, 2015 السّلام عليكم و رحمة الله و بركاته الأساتذة الأفاضل : محمد حسن المحمد ياسر خليل أبو البراء رمهان قلم الاكسل بارك الله فيكم جميعًا .. جزاكم الله خيرًا و زادها بميزان حسناتكم .. موضوع مميّز و حوار شيّق بشكل رائع .. استفدنا منه الكثير فائق احتراماتي 2
جعفر الطريبق قام بنشر أكتوبر 4, 2015 قام بنشر أكتوبر 4, 2015 (معدل) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 ء آ أ ؤ إ ئ ا ب ة ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ف ق ك ل م ن ه و ى ي السلام عليكم يمكن تبسيط الكود باستغلال القيمة العددية للحروف : ASCII لم أجرب الكود لأنه لأنني ضيعت سيدي الويندوز المطلوب عند محاولة تغيير اللغة عن طريق ال Regional Settings Function AlphaSum(ByVal Word As String) As Long Dim i As Long Word = Replace(Word, " ", "") For i = 1 To Len(Word) AlphaSum = AlphaSum + Asc(Mid(Word, i, 1)) - IIf(Asc(Mid(Word, i, 1)) > &H63A, &H626, &H620) Next End Function تم تعديل أكتوبر 4, 2015 بواسطه جعفر الطريبق أخد بعين الاعتبار Spaces
محمد حسن المحمد قام بنشر أكتوبر 4, 2015 الكاتب قام بنشر أكتوبر 4, 2015 السلام عليكم أستاذنا الكبير جعفر الطريبق المحترم جزاكم الله خيراً...على هذه المساهمة الطيبة لإيجاد الحل المناسب... لي رأي أعرضه على أساتذتي الأكارم: وهو تساؤل أعرضه على كل الأساتذة الأجلاء الذين ساهموا في هذا الموضوع كما يلي: ألا تختلف قيم النتائج باختلاف عدد الأحرف ..وكذلك باختلاف موقع كل حرف ..حيث قام مجموعة منهم بالحساب على أساس 28 حرفاً .وقام القسم الآخربحسابها 36 حرفاً بالرجوع إلى طريقة كتابة كل حرف باعتباره حرفاً جديداً. والمطلوب - فضلاً لا أمراً - الاتفاق على عدد الأحرف ...وترتيبها حسب موقعها بالنسبة للغات البرمجة لا باعتبار معرفتنا للترتيب الهجائي المعروف للجميع وكذلك طرح الفراغات التي تعتبر بمثابة حروف جزاكم الله خيراً ...والشكر موصول لكم جميعاً ...لا تؤاخذوني على مداخلتي إن كان بها أي خطأ في التعبير باعتباري طالب مستجد في جامعتكم الكريمة الموقرة...والسلام عليكم.
جعفر الطريبق قام بنشر أكتوبر 4, 2015 قام بنشر أكتوبر 4, 2015 (معدل) الأستاد الفاضل محمد حسن المحمد شكرا على الملاحظة القيمة ... أعتقد أن الحساب على أساس 28 أو 36 مرهون بارادة المستخدم ... أنا أفضل الحساب على أساس 36 حرف لأنه أشمل ASCII MAP و نفس الأمر بالنسبة للفراغات فهو أمر مرتبط بما يريده طالب الكود أو المستخدم ... يمكن تعديل الأكواد على حسب الرغبة و على حسب عدد الحروف المطلوبة تم تعديل أكتوبر 4, 2015 بواسطه جعفر الطريبق
سليم حاصبيا قام بنشر أكتوبر 4, 2015 قام بنشر أكتوبر 4, 2015 (معدل) نعض التعديلات على الملف ليتجاهل كل شيئ غير مرغوب فيه و (يمكن الكتابه به اللغة الاجنبية) /, . @ ,%, $ , "" ," " و غيره الكثير (انظر الى الصفحة Letters) مجموع حروف advanced.zip تم تعديل أكتوبر 4, 2015 بواسطه سليم حاصبيا
محمد حسن المحمد قام بنشر أكتوبر 4, 2015 الكاتب قام بنشر أكتوبر 4, 2015 السلام عليكم الشكر الجزيل للأستاذ جعفر الطريبق المحترم على إيضاحاته شكرا على الملاحظة القيمة ... أعتقد أن الحساب على أساس 28 أو 36 مرهون بارادة المستخدم ... أنا أفضل الحساب على أساس 36 حرف لأنه أشمل ASCII MAP و نفس الأمر بالنسبة للفراغات فهو أمر مرتبط بما يريده طالب الكود أو المستخدم ... يمكن تعديل الأكواد على حسب الرغبة و على حسب عدد الحروف المطلوبة كما أشكر الأستاذ الكريم سليم حاصبيا على معادلاته التي أظهر من خلالها مرونة مع التعامل مع الأحرف العربية أو الأجنبية وتجاهل الأحرف ما لا نود إدراجه بعض التعديلات على الملف ليتجاهل كل شيئ غير مرغوب فيه و (يمكن الكتابه به اللغة الاجنبية) /, . @ ,%, $ , "" ," " و غيره الكثير (انظر الى الصفحة Letters) تقبلوا تحياتي العطرة.. 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.