كود نسخ البيانات النصية فقط

[احمد النكلاوي]

عندي  ملف به بيانات يتم استخراجها من برنامج

احد الاعمدة توجد بيانات نصية عبارة عن اسماء العملاء

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

ما  هو مطلوب موضح في الصورة

هذا هو الملف المطلوب 

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

 

 

تم تعديل يونيو 12, 2020 بواسطه احمد النكلاوي

[احمد النكلاوي]

عندي  ملف به بيانات يتم استخراجها من برنامج

احد الاعمدة توجد بيانات نصية عبارة عن اسماء العملاء

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

ما  هو مطلوب موضح في الملف

من فضلك لا تكرر نفس المشاركات والا ستحذف جميع المشاركات

1.xls

[احمد النكلاوي]

هذا هو الملف المطلوب 

وانا اسف علي لعدم ادراكي أهمية هذا الأمر 

[احمد النكلاوي]

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

لأ طبعاً ممنوع فتح مشاركة لنفس الطلب ,.. التمس العذر دائماً للأساتذة فانت لا تعرف أوقاتهم ولا تستعجل الرد الا بكلمة للـــــرفع

ولكن ليس كل نصف ساعة اعطى لنفسك الوقت الكافى لذلك حتى وان كانت كل ساعتين

[عبدالفتاح في بي اكسيل]

المطلوب  غير  واضح  الصورة  غير  متوافقة  مع  الملف  لقد  عملت  بناء  على  الملف 

Sub rep_nam_num()
Dim c As Range

For Each c In Range("B3", Range("B" & Rows.Count).End(3))
  If c.Value Like "*[ا-ي]*" Then
    c.Offset(, 13) = c.Value
    c.Offset(, 14) = c.Offset(, 1).Value
  Else
    c.Offset(, 13) = c.Offset(-1, 13).Value
    c.Offset(, 14) = c.Offset(-1, 14).Value
  End If
Next

End Sub

 

1 (2).xls

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

الأخ الصديق عبد الفتاح

كود أكثر من رائع جزاك الله خيراً

لكن نسيت شيئاً وهو تسلسل الأرقام    (في حال تكرار الاسم الرقم يجب ان يزيد 1 عما قبله)

تعديل بسيط أرجو تقبله

Sub rep_nam_num()
Dim c As Range

If Range("O2").CurrentRegion.Rows.Count > 1 Then _
 Range("O2").CurrentRegion.Offset(1). _
 Resize(Range("O2").CurrentRegion.Rows.Count - 1).ClearContents
 
For Each c In Range("B3", Range("B" & Rows.Count).End(3))
  If c.Value Like "*[ا-ي]*" Then
    c.Offset(, 13) = c.Value
    c.Offset(, 14) = c.Offset(, 1).Value
  Else
    c.Offset(, 13) = c.Offset(-1, 13).Value
    c.Offset(, 14) = _
    IIf(Val(c.Offset(-1, 14)) = 0, c.Offset(-1, 14), _
     c.Offset(-1, 14) + 1)
  End If
Next

End Sub

 

 

 

Salim.xls

[احمد النكلاوي]

بارك الله فيي الجمييع وشكرا لاساتذتي الكرام 

انا اسف علي التأخر في الرد لظروف خارجة عن ارادتي 

ساقوم بتجربة الكود وساوافيكم بالرد