مطلوب برمجة الحروف معكوسة

[قلم-الاكسل(عبدالعزيز)]

 

السلام عليكم مهندسونا العزيز

ادعو الله ان يتم عليكم موفور الصحة والبركة في الرزق

ما هي الطريقة التي اجعل فيها الاكسل يقوم تلقائيا ببرمجة الحروف معكوسة مثلا

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

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

يعني بعد ما اكتب الدالات وغيرها في الاكسل مثلا

او

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

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

 

اكتب مثلا في مربع1 جملة او كلمة او حتى قطعة كاملة مكونة من كلمات يصل عددها 100

مثلا كلمة "ا ل ص ح ة " يظهر لي مربع 2 "

   ي ح ض ل ت   

وهي شبيهة بلعبة التخمين للكلمات

وهاكم الملف يشرح اللعبة

 

•  
• واعتذر لكم يا ابو البراء ظننت انه لا يسمح لي برفع الملفات من الموقع الا بعد تجاوز مشاركتي اكثر من 100
•  
• Quote

الحروف المعكوسة.zip

تم تعديل أكتوبر 5, 2015 بواسطه قلم-الاكسل

[ياسر خليل أبو البراء]

أخي الكريم

قم بضغط ملفك ثم ارفعه على المنتدى بدلاً من الروابط الخارجية

[بن علية حاجي]

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

لست أدري إن كنت قد فهمت المطلوب... انظر إلى المرفق وقد تم فيه إضافة كود دالة مستحدثة تعمل عمل الدالة CONCATENATE مع بعض الخصوصية... أرجو من الله أن يكون فيه المطلوب أو بعضه... (مع خاصية التبديل بين عمودي التحويل من رقم العمود في الخلية I1 إلى رقم العمود في الخلية M1)

بن علية

 

الحروف المعكوسة.rar

[وائل الاسيوطي]

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

لست أدري إن كنت قد فهمت المطلوب... انظر إلى المرفق وقد تم فيه إضافة كود دالة مستحدثة تعمل عمل الدالة CONCATENATE مع بعض الخصوصية... أرجو من الله أن يكون فيه المطلوب أو بعضه... (مع خاصية التبديل بين عمودي التحويل من رقم العمود في الخلية I1 إلى رقم العمود في الخلية M1)

بن علية

 

الحروف المعكوسة.rar

جزاك الله خيرا اخي بن علية وولي طلب هل يمكن تعديل الملف ليحول سلسله من الحروف والارقام الي تاريخ مثلا EAW-TRF-HGRT الي 20-11-2015 والعكس 

[قلم-الاكسل(عبدالعزيز)]

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

لست أدري إن كنت قد فهمت المطلوب... انظر إلى المرفق وقد تم فيه إضافة كود دالة مستحدثة تعمل عمل الدالة CONCATENATE مع بعض الخصوصية... أرجو من الله أن يكون فيه المطلوب أو بعضه... (مع خاصية التبديل بين عمودي التحويل من رقم العمود في الخلية I1 إلى رقم العمود في الخلية M1)

بن علية

 

الحروف المعكوسة.rar

بن علية انتي علي ودوم في العلا 

فعلا هو ما اريد 

لا تقل "ان كنت قد فهمت المطلوب" فأنت مصنع الفهم ودكتوراة في الفهم

بارك الله فيك ووفقك  وسدد خطاك وغفر لك ولوالديك ولجميع   المسلمين

ووسع عليك في الرزق والخيرات وإن شاء الله ستتهاطل عليك نعمه مثل قطرات الأمطار الغزيرة

ويحفظك ربنا الله الحفيظ من سوء ومرض وعرض

وفعلا نزلت الملف ونجح كاملا تاما عاما 

100000000000000 %

البرمجة صحيحة

ليت مخي يسرق شيء من مخك بس للاسف اخاف من السجن 

تم تعديل أكتوبر 6, 2015 بواسطه قلم-الاكسل

[ياسر خليل أبو البراء]

أخي الكريم قلم الإكسيل

إليك الدالة المعرفة التالية تغنيك عن استخدام الجدول الموجود

Function dhTranslate(ByVal strIn As String, Optional ByVal strMapIn As String, Optional ByVal strMapOut As String, Optional fCaseSensitive As Boolean = True) As String
    Dim intI As Integer
    Dim intPos As Integer
    Dim strChar As String * 1
    Dim strOut As String
    Dim intMode As Integer

    strMapIn = Join(Array("أ", "ب", "ت", "ث", "ج", "ح", "خ", "د", "ذ", "ر", "ز", "س", "ش", "ص", "ض", "ط", "ظ", "ع", "غ", "ف", "ق", "ك", "ل", "م", "ن", "ه", "و", "ي"))
    strMapOut = Join(Array("أ", "ب", "ج", "د", "ه", "و", "ز", "ح", "ط", "ي", "ك", "ل", "م", "ن", "س", "ع", "ف", "ص", "ق", "ر", "ش", "ت", "ث", "خ", "ذ", "ض", "ظ", "غ"))

    If Len(strMapIn) > 0 Then
        If fCaseSensitive Then
            intMode = vbBinaryCompare
        Else
            intMode = vbTextCompare
        End If

        If Len(strMapOut) > 0 Then
            strMapOut = Left$(strMapOut & String(Len(strMapIn), _
                                                 Right$(strMapOut, 1)), Len(strMapIn))
        End If
        For intI = 1 To Len(strIn)
            strChar = Mid$(strIn, intI, 1)
            intPos = InStr(1, strMapIn, strChar, intMode)
            If intPos > 0 Then
                strOut = strOut & Mid$(strMapOut, intPos, 1) & " "
            Else
                strOut = strOut & strChar & " "
            End If
        Next intI
    End If

    dhTranslate = strOut
End Function

 

الحروف المعكوسة.rar

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

جرب  هذا الملف 

بعد اذن اخي ياسر الدالة ابسط بكثير مما تتوقعه

 

Reverse_function.zip

[ياسر خليل أبو البراء]

أخي الحبيب الغالي سليم

ليس المقصود عكس الحروف كما تفضلت إنما المقصود من الموضوع استبدال مجموعة الحروف الموجود بحروف مقابلة لكل حرف

راجع الموضوع وراجع الملف المرفق الذي تفضل به أخونا بن علية حاجي والملف الذي تقدمت به وشوف النتائج

تقبل تحياتي

[رمهان]

وهذه محاولة مع الاساتذة

Function ramhan(xinput As String) As String
Dim i As Integer, xsum As String, xletter As String
xletter = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
xinput = Replace(xinput, "أ", "ا")
xinput = Replace(xinput, "إ", "ا")
xinput = Replace(xinput, "ة", "ه")
For i = 1 To Len(xinput)
xsum = xsum & mid("يوهنملكقفغعظطضصشسزرذدخحجثتبا", InStr(1, xletter, mid(xinput, i, 1)), 1)
Next i
ramhan = xsum
End Function

بالتوفيق

[قلم-الاكسل(عبدالعزيز)]

المهندس ياسر بارك الله فيك 

مشكور على الملف والمشاركة وانه لشرف كبير لنا على منحك المتواصلة

لما افتح الملف واكتب فيه كلمة في الخانة الثانية تأتي نفس حروف الكلمة مثل

الصحة

ا ل ص ح ة

مع انني رأيت الدالة موجود في مقابل العمود

"ا ب ت ث ج ........ ألخ"

يقابله

"ا ب ج د هـ .....الخ"

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

وللعلم لدي اكسل 2013  الواجهة الانكليزية

[ياسر خليل أبو البراء]

جربت الملف مرة أخرى وكتبت كلمة الصحة وأعطتني النتيجة "ا ث ن و ة"

لا أدري ما المشكلة لديك ..

يمكنك أن تذهب للتبويب Formulas ثم Calculation Options واختر الأمر Automatic

[وائل احمد المصري]

اخي قلم الأكسيل الملف يعمل بالطريقتين طريقة اخي ياسر واخي رمهان

قد يكون لديك مشكلة بالاكسيل

معلومة: كانت لدي مشكلة مع الاكسيل ولم استطع حلها الا عندما قمت بعمل يوزر جديد ومسحت اليوزر القديم

 

الحروف المعكوسة.rar

[ياسر خليل أبو البراء]

أخي الكريم رمهان

دالتك تعمل بشكل جيد إذا كان النص كلمة واحدة ..بينما تعطي خطأ إذا كانت هناك أكثر من كلمة ..

جرب بنفسك

 

أخي الحبيب وائل

مشكور على المشاركة الفعالة في الموضوع ..بارك الله فيك

[قلم-الاكسل(عبدالعزيز)]

جربت الملف مرة أخرى وكتبت كلمة الصحة وأعطتني النتيجة "ا ث ن و ة"

لا أدري ما المشكلة لديك ..

يمكنك أن تذهب للتبويب Formulas ثم Calculation Options واختر الأمر Automatic

 استاذنا الغالي

قمت باختيار اتوماتيك لكن المشكلة نفسها

احتمال الخطأ من نسخة الاوفيس عندي

لانه حتى لما اكتب بعض المعادلات في الموقع لا تنجح معي

شكرا لك على المشاركات الفعالة والهادفة

باركك الله دوما

شكرا لاستاذنا الجليل وائل ابو الأوائل وفي الخير دوما صائل

وعسى الله يجعل بينك وبين اعدائك حائل

ويحفظك من كل شر ومن الرذائل

يا ابو الاوائل

[ياسر خليل أبو البراء]

أخي الكريم قلم الإكسيل

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

[رمهان]

أخي الكريم رمهان

دالتك تعمل بشكل جيد إذا كان النص كلمة واحدة ..بينما تعطي خطأ إذا كانت هناك أكثر من كلمة ..

جرب بنفسك

شرفتنا بالتعقيب والملاحظة استاذنا القدير ابو البراء !

والآن ؟ :

Function ramhan(xinput As String) As String
Dim i As Integer, xsum As String, xletter As String
xletter = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
xinput = Replace(xinput, "أ", "ا")
xinput = Replace(xinput, "إ", "ا")
xinput = Replace(xinput, "ة", "ه")
xinput = Replace(xinput, " ", "")
For i = 1 To Len(xinput)
xsum = xsum & " " & mid("يوهنملكقفغعظطضصشسزرذدخحجثتبا", InStr(1, xletter, mid(xinput, i, 1)), 1)
Next i
ramhan = Trim(xsum)
End Function

تحياتي للجميع

[ياسر خليل أبو البراء]

بارك الله فيك أخي الحبيب رمهان ولكن ما تزال النتائج مختلفة ..جرب الدالتين بنفسك وقارن النتائج

يمكن عمل تعديل بسيط على الدالة الرائعة التي قدمتها لنصل لنتائج صحيحة إن شاء الله

Function Ramhan(Xinput As String) As String
    Dim I As Long, Xsum As String, Xletter As String
    Xletter = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
    Xinput = Replace(Xinput, "أ", "ا")
    Xinput = Replace(Xinput, "إ", "ا")
    Xinput = Replace(Xinput, "ة", "ه")
    Xinput = Replace(Xinput, " ", "")
    For I = 1 To Len(Xinput)
        Xsum = Xsum & " " & Mid("ابجدهوزحطيكلمنسعفصقرشتثخذضظغ", InStr(1, Xletter, Mid(Xinput, I, 1)), 1)
    Next I
    Ramhan = Trim(Xsum)
End Function

 

[قلم-الاكسل(عبدالعزيز)]

أخي الكريم قلم الإكسيل

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

شكرا لك عزيزنا المهندس القدير

بارك الله فيك ووسع عليك وحفظك واسعدك دنيا وآخرة

[رمهان]

بارك الله فيك أخي الحبيب رمهان ولكن ما تزال النتائج مختلفة ..جرب الدالتين بنفسك وقارن النتائج

يمكن عمل تعديل بسيط على الدالة الرائعة التي قدمتها لنصل لنتائج صحيحة إن شاء الله

Function Ramhan(Xinput As String) As String
    Dim I As Long, Xsum As String, Xletter As String
    Xletter = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
    Xinput = Replace(Xinput, "أ", "ا")
    Xinput = Replace(Xinput, "إ", "ا")
    Xinput = Replace(Xinput, "ة", "ه")
    Xinput = Replace(Xinput, " ", "")
    For I = 1 To Len(Xinput)
        Xsum = Xsum & " " & Mid("ابجدهوزحطيكلمنسعفصقرشتثخذضظغ", InStr(1, Xletter, Mid(Xinput, I, 1)), 1)
    Next I
    Ramhan = Trim(Xsum)
End Function

 

اعتقد استاذنا القدير ان المسالة مسالة ترتيب الاحرف في المتغير xletter  ومايقابله من الحروف في الجملة النصية المكتوبة والتي تمثل المواقع المقابلة لكل حرف !

تحياتي

[ياسر خليل أبو البراء]

بالفعل أخي الغالي رمهان

مشكور على الدالة الجميلة والرائعة ..أنت السهل الممتنع

تقبل الله منا ومنكم

[رمهان]

بالفعل أخي الغالي رمهان

مشكور على الدالة الجميلة والرائعة ..أنت السهل الممتنع

تقبل الله منا ومنكم