اذهب الي المحتوي
أوفيسنا

دمج عمودين على التوالى


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

اساتذتنا الكرام

كيف يمكن دمج بيانات عمودين على التوالى بمجرد انتهاء بيانات العمود الاول ( عدد صفوف الاعمدة غير ثابتة )

مع مراعاة ان بيانات العمود الثانى مجزأة ( بينها فراغات )

وهل يمكن التطبيق على اكثر من عمودين 

ارجوا ان يكون ذلك من خلال المعادلات 

وشكراً على اهتمامكم 

 

دمج عمودين على التوالى.xlsx

رابط هذا التعليق
شارك

ما اروع الحلول لديك استاذنا سليم 

جزاك الله خيرا

اعتذر مقدما على الاطالة 

هل يمكن تطوير الحل بحيث يشمل ان العمود الثانى غير متصل وبه فراغات 

وشكرا جزيلا

دمج عمودين على التوالى.xlsx

  • Like 1
رابط هذا التعليق
شارك

ابداع اساتذتنا ومنه نتعلم

شكرا استاذنا مهندس الاكسل والشكر موصول لاستاذنا سليم

ولكن ظهرت بعض الصعوبة لدى تتمثل فى ----

اذا فرضنا ان محتوى العمودين ارقام وليست اسماء 

كيف يمكن جعل النتيجة تظهر عند الدمج مرتبه من الاصعر الى الاكبر 

دمج عمودين على التوالى (1).xlsx

رابط هذا التعليق
شارك

  • أفضل إجابة

يمنكك تجربة هذا الملف (صفحة Salim)

Option Explicit
Sub All_in_One()
  Dim S As Worksheet
  Dim Rg_A As Range, Rg_D As Range
  Dim i%, m%, La%, LD%
  Dim Obj_Num As Object, Obj_Text As Object

Set S = Sheets("Salim")
S.Range("I2").Resize(1000).Clear
La = S.Cells(Rows.Count, 1).End(3).Row
LD = S.Cells(Rows.Count, 4).End(3).Row
Set Obj_Num = CreateObject("System.collections.Arraylist")
Set Obj_Text = CreateObject("System.collections.Arraylist")
 For i = 2 To La
  If S.Cells(i, 1) <> vbNullString Then
   If IsNumeric(S.Cells(i, 1)) Then
    Obj_Num.Add S.Cells(i, 1).Value
   Else
    Obj_Text.Add S.Cells(i, 1).Value
  End If
  End If
 Next
 '+++++++++++++++++++++++++++++
  For i = 2 To LD
  If S.Cells(i, 4) <> vbNullString Then
   If IsNumeric(S.Cells(i, 4)) Then
    Obj_Num.Add S.Cells(i, 4).Value
   Else
    Obj_Text.Add S.Cells(i, 4).Value
   End If
  End If
 Next
 If Obj_Num.Count Then
   Obj_Num.Sort
  End If
  If Obj_Text.Count Then
   Obj_Text.Sort
  End If
  m = 2
  If Obj_Num.Count Then
    S.Cells(m, "i").Resize(Obj_Num.Count) = _
    Application.Transpose(Obj_Num.toarray)
   S.Range("I2").Resize(Obj_Num.Count) _
    .Interior.ColorIndex = 35
    m = m + Obj_Num.Count - 1
  End If
  If Obj_Text.Count Then
    S.Cells(m, "i").Resize(Obj_Text.Count) = _
    Application.Transpose(Obj_Text.toarray)
    S.Cells(m, "i").Resize(Obj_Text.Count) _
   .Interior.ColorIndex = 40
   m = m + Obj_Text.Count - 1
  End If
  With S.Range("i2").Resize(m - 1)
   .Borders.LineStyle = 1
   .Font.Size = 14: .Font.Bold = True
   .InsertIndent 1
   End With
  End Sub

الملف مرفق (الصفحة Salim)

 

ABOU_Yahya Two_in_One.xlsm

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

جزيل الشكر لك استاذنا سليم 

وعذرا لكثرة استفساراتى فانا ازداد بها علما من اساتذتى الكرام 

وبالفعل حاولت استخدام دالة MINIFS بداخل معادلة صفيف 

لكنى لم افلح

فلك كل الشكر 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information