أكاديمية الصقر للتدريب

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



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .




11-10-2018 05:54 صباحا
مشاهدة مشاركة منفردة [5]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 336
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 14
قوة السمعة : 2929
الاعجاب : 88
 offline 
look/images/icons/i1.gif سؤال عن دمج الخلايا
المشاركة الأصلية كتبت بواسطة:ali mohamed ali
تفضل لقد تم الحل  من قبل الأستاذ سليم له منا كل المحبة والإحترام
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب

 
مع اني لا احب هذا اللعبة التي يدعونها  دمج الخلايا ولا استسيغ العمل بها
يمكن  تعديل الكود الى هذا الشكل (في حال زيادة البيانات لادراج اسماء الشركات)

Option Explicit
Sub test()
If ActiveSheet.Name <> "Salim" Then Exit Sub
Dim My_Rg As Range
Dim r, x, i, m, k
Dim st$
Set My_Rg = Range("a1").CurrentRegion.Columns(1)
 
With Range("H:h")
.Offset(, -1).ClearContents
.ClearContents
.UnMerge
End With
r = My_Rg.Rows.Count
For i = 1 To r
      Range("G" & i) = My_Rg.Cells(i)
      x = My_Rg.Cells(i).MergeArea.Rows.Count
      If x > 1 Then
       m = 1
     For k = i To i + x - 1
       st = st & Cells(i + m - 1, 2) & " " & Chr(10)
     m = m + 1
     Next
        With Range("H" & i)
         .Resize(x).Merge
         .Value = Mid(st, 1, Len(st) - 1)
        End With
    m = 1
    st = vbNullString
       i = i + x - 1
          Else
       Range("H" & i) = My_Rg.Cells(i).Offset(, 1)
   End If
Next
End Sub



اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 01:42 مساء

أعلن هنا
أعلن هنا
أعلن هنا