تحويل رقم من سبع خانات الى احرف

[سامي علي أحمد]

السلام عليكم ورحمه الله وبركاتي 

اخواني الاعزاء احتاج الى معادله لتحويل الارقام الى احرف مقابله لها كمثال 

5658556

XYXZXXY

شرط اذا كان الرقم يحتوي على صفر ان تبقا قيمه الصفر نفسها كمثال 

5670676

XYZ0YZY

X بما يعنيه الرقم الاول يقابله حرف 

Y الرقم الثاني يقابله حرف 

Z الرقم الثالث يقابله حرف 

A الرقم الرابع يقابله حرف 

B الرقم الخامس يقابله حرف 

C الرقم السادس يقابله حرف 

D الرقم السابع يقابله حرف 

اذا كان الرقم يحتوي 0 ان تبقى قيمه الصفر نفسها عند التحويل 

لقد قمت بارفاق ملف اكسل عله يوضح اكثر 

ولكم جزيل الشكر على جهودكم الجباره 

XYZ sample.rar

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

وعليكم السلام

إن شاء الله يساعدك أحد الأخوة في طلبك ولكن لي سؤال ما الفائدة من هذا الأمر (من باب الفضول لا أكثر)

 

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

جرب هذا الكود

Sub replace_for_me1()
 
 Dim my_arr()
 Dim my_st, my_text As String
 Dim my_aar2()
 Dim k, x, lr As Integer

 lr = Sheets("sheet1").Cells(Rows.Count, 1).End(3).Row
        For k = 2 To lr
               ReDim my_arr2(1 To 7)
               my_arr = Array("X", "Y", "Z", "A", "B", "C", "D")
                my_st = Range("a" & k)
                 
                            For i = 1 To 7
                               s = Mid(my_st, i, 1)
                               If s = "0" Then my_arr(i - 1) = s: GoTo 1
                               my_arr2(i) = my_arr(i - 1)
1:
                             Next
                    my_text = ""
                          For x = LBound(my_arr) To UBound(my_arr)
                            my_text = my_text & my_arr(x)
                          Next
                    Range("a" & k).Offset(0, 2) = my_text
        Next
 
End Sub

 

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

الموضوع فيه لبس في المنطق ...

في المثال المرفق من قبل الأخ سامي يوجد في الصف الثاني

3443043

والناتج المطلوب

XYYX0XY

أليس حسب المنطق المشروح في المشاركة الأولى أن يكون بهذا الشكل XYYX0YX ؟؟

 

في ملف الأخ سليم خرجت النتيجة بهذا الشكل XYZA0CD

يرجى تأكيد المنطق الصحيح لكيفية إجراء العملية ، والرد على تساؤلي ما الهدف من إجراء تلك العملية؟

 

[سامي علي أحمد]

صديقي العزيز ياسر بالنسبه ل

3443043 الناتج كما تفضلت حضرتك هو 

XYYX0YX

بالخطأ تم ادخاله بالشكل الذي تفضلت به 

الاستفاده من الموضوع هو عمليه فلتره الارقام المتشابهة بالترتيب عن طريق الاحرف 

 صديقي العزيز سليم شكرا على الرد ولكن النتيجه الحاصله غير صحيحه يوجد خطأ بالكود على ما اعتقد

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

ارجو التتعديل والمساعد وشكرا 

 

 

مقارنه.rar

تم تعديل فبراير 14, 2017 بواسطه سامي علي أحمد

[سامي علي أحمد]

ماصديقي العزيز سليم شكرا على الرد ولكن النتيجه الحاصله غير صحيح يوجد خطأ بالكود على ما اعتقد ارجو التتعديل والمساعد وشكرا 

 

 

مافي حل يا جماعه الخير !!!!!!!؟؟؟؟؟؟؟؟؟

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

ضع الدالة المعرفة التالية (توضع في موديول وتستخدم في ورقة العمل كالمعادلات)

اضغط Alt + F11 لفتح محرر الأكواد >> من قائمة Insert قم بإداج موديول جديد >> انسخ الدالة المعرفة التالية وضعها في الموديول 

Function Translate(s As String) As String
    Dim dic     As Object
    Dim arr     As Variant
    Dim i       As Long
    Dim j       As Long
    Dim c       As String
    Dim r       As String

    r = s
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Array("0", "X", "Y", "Z", "A", "B", "C", "D")
    
    For i = 1 To Len(s)
        c = Mid(s, i, 1)
        If c <> "0" Then
            If Not dic.exists(c) Then
                dic.Add c, c
                j = j + 1
                r = Replace(r, c, arr(j))
            End If
        End If
    Next i
    
    Translate = r
End Function

الآن قم بوضع المعادلة التالية في الخلية B2

=Translate(A2)

 

[سامي علي أحمد]

صديقي العزيز ياسر اقدر جهودك الجباره 

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

هل من الممكن تطبيقها على الملف المرفق بالمشاركه السابقه وادراجها هنا وساكون لك من الشاكرين  

تم تعديل فبراير 14, 2017 بواسطه سامي علي أحمد

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

أخي الكريم

اطلع على الرابط التالي بشكل جيد أولاً وإذا صادفتك مشكلة أبلغنا بها (لابد من معرفة أبجديات التعامل مع البرمجة)

الرابط من هنا

[سامي علي أحمد]

صديقي العزيز اقدر جهودك الجباره 

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

هل من الممكن تطبيقها على الملف المرفق بالمشاركه السابقه وادراجها هنا وساكون لك من الشاكرين  

صديقي العزيز ياسر لقد قمت بتطبيق الخطوات بالملف ولكن ما زلت اواجه رساله خطا اعذرني على التعب 

لقد ارفقت الملف الذي طبقت عليه المعادله 

XYZ sample.rar

صديقي العزيز ياسر لقد قمت بتطبيق الخطوات بالملف ولكن ما زلت اواجه رساله خطا اعذرني على التعب 

لقد ارفقت الملف الذي طبقت عليه المعادله 

XYZ sample.rar

[سامي علي أحمد]

صديقي العزيز اقدر جهودك الجباره 

شكرا لك جزيل الشكر لقد طبقتها بشكل صحيح

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

السلام عليكم

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

بن علية

XYZ sample.rar

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

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

XYZ sample.rar