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

[احب العلم]

بسم الله الرحمن الرحيم

السلام عليكم أخواني وأستاذتي في هذا الصرح المبارك..

أخواني في هذا الملف المرفق كود أخذتة من أحد أستاذت هذا الصرح العظيم جزهُ الله كل الخير وزداه رفعا وعلما ..  عمل الكود يبدل مواقع الحروف ويكرر نفس الترتيب على بقيت الصفوف وهو المطلوب ما موجود في الكود الحالي .. لكن المشكلة تبقى عملية التكرار مستمرة .. الذي أطلبوه من حضرتكم التكرار يكون بشرط أي بمعنى أن يتوقف التكرار عندما يصبح السطر الأخير من التكرار نفس السطر الأول ويتوقف التكرار.. وأنا شارح ذلك في الملف المرفق أرجوا الطلاع عليه ..

رجاء من حضرتكم لا أمر عليكم

وتقبلوا خالص تحياتي

الملف .rar

[احمد عبد الناصر]

السلام عليكم

 

اخي الكريم

 

جرب هذه 

Dim DI As Integer

Sub Dahmour()
c = 0
i = 2
Z = 3
For x = Range("iv1").End(xlToLeft).Column To 2 Step -1

If c >= (Range("iv1").End(xlToLeft).Column - 1) / 2 Then
For xx = 2 To Range("iv1").End(xlToLeft).Column - c
Cells(DI + 2, Z) = Cells(DI + 1, xx)
c = c + 1
Z = Z + 2
Next
For ic = 2 To Range("iv1").End(xlToLeft).Column
SI = SI & "-" & Cells(DI + 2, ic)
SII = SII & "-" & Cells(1, ic)
Next

If SI = SII Then
Exit Sub
Else
GoTo 5
End If

End If

Cells(DI + 2, i) = Cells(DI + 1, x)
c = c + 1
i = i + 2

Next
If sd = 8 Then
5:
DI = DI + 1
Dahmour
End If
DI = 0
End Sub

تحياتي

الملف++-+ .rar

[احمد عبد الناصر]

جرب هذا الكود فهو ابسط و ادق 

Sub Dahmour()
For ic = 2 To Range("iv1").End(xlToLeft).Column
SII = SII & "-" & Cells(1, ic)
Next
Do
c = 0
i = 2
Z = 3
For x = Range("iv1").End(xlToLeft).Column To 2 Step -1

If c >= (Range("iv1").End(xlToLeft).Column - 1) / 2 Then
For xx = 2 To Range("iv1").End(xlToLeft).Column - c
Cells(DI + 2, Z) = Cells(DI + 1, xx)
c = c + 1
Z = Z + 2
Next
GoTo 1
End If

Cells(DI + 2, i) = Cells(DI + 1, x)
c = c + 1
i = i + 2

Next
1:
SI = ""
For ic = 2 To Range("iv1").End(xlToLeft).Column
SI = SI & "-" & Cells(DI + 2, ic)
Next
If SI = SII Then Exit Sub
DI = DI + 1
Loop
End Sub

[احب العلم]

وعليك السلام يامبدع آسف تأخرت عليك بلرد خط النت عندنا  ضعيف جدا بسبب الأمطار..

ماذا أقول لك وكيف أبدأ كلامي ..وها أنت اليوم تكمل فضلك علي مره ثانية وتكمل لي ماصنعت يداك لي.. لأنك ياأستاذ أحمد عبد الناصر أنت صاحب الفضل الأول علي بهذا الكود وأنا في مشاركتي أشرتُ أليك تلميحا ولم أذكر أسمك.. ولكن هل يخفى القمر ؟ والله أني خجلا منك وعاجز عن شكرك لأني أثقلت عليك لكن عشمي بك وبي أخلاقك العالية وهو الذي أطمعني بكرمك مره ثانية .. مشكور لك ياأستاذي لأنك لم تخيب ضني بك فهذا هو عشمي بك  وبلأخوة الأعضاء والأستاذة الكرام في هذا البيت العائلي .. أحسنت وعاشت يداك هذا هو ماكنت أريده بضبط من تنفيذ الكود بهذه الدقة  .. بارك الله بك وحفظك ورعاك وزداك علماً ورفعة .. مشكور (يارائع)

 

من علمني حرفاً ملكني عبداً

[احمد عبد الناصر]

السلام عليكم 

 

اخي الكريم ,

 

بداية ارجو ان تستخدم الكود الثاني مشاركة رقم 3 .

 

شاكر لك كلماتك العطرة ,لكن الموضوع ابسط من هذا رزقنا الله نحن و اياكم الصبر و الاخلاص و تقبل منا و منكم صالح الاعمال .

 

تقبل تحياتي 

[احب العلم]

شكرا لك أستاذ أحمد على متابعتك لموضوع وفعلا تم استخدام الكود الثاني وكانت النتيجة رائعة جدا وهو ما كان المطلوب ..

اللهم يقضي لك حاجة مثلما تقضي حوائجنا أنه سمعيا مجيب وبل أجابة قدير