دمج عدة خلايا في خلية واحدة

[skyblue]

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

اخواني المشرفيين ارجوا التكرم بعمل كود برمجي يضم ارقام الخليتين a1 وb1 في الخلية d1 وان تكون بينهم شرطة صغيرة كما هو موضح في الملف المرفق

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

[محمد حجازي]

السلام عليكم ...

جرب الكود التالي:

Sub Integrate()
On Error GoTo YourMistake
Dim MyRange As Range
Dim NumberColumn As Integer
Dim MyText As String
Dim i As Long
Dim ii As Integer
Set MyRange = Application.InputBox(prompt:="أدخل مجال الدمج", Title:="مجال الدمج", Type:=8)
NumberColumn = Application.InputBox(prompt:="أدخل رقم العامود الذي تريد عرض النتائج فيه", Title:="عامود النتائج", Type:=1)
If NumberColumn <= 0 Then
  MsgBox prompt:="يجب أن يكون رقم العامود عدد صحيح أكبر من الصفر", Title:="خطأ"
ElseIf NumberColumn >= MyRange.Column And NumberColumn <= MyRange.Column + MyRange.Columns.Count - 1 Then
  MsgBox prompt:="عامود النتائج موجود ضمن عامود الدمج", Title:="خطأ"
Else
  Worksheets(MyRange.Worksheet.Name).Range(Cells(MyRange.Row, NumberColumn), Cells(MyRange.Row + MyRange.Rows.Count - 1, NumberColumn)).ClearContents
  For i = MyRange.Row To MyRange.Row + MyRange.Rows.Count - 1
    For ii = MyRange.Column To MyRange.Column + MyRange.Columns.Count - 1
      If Worksheets(MyRange.Worksheet.Name).Cells(i, ii).Value = "" Then GoTo 1
      MyText = Worksheets(MyRange.Worksheet.Name).Cells(i, ii).Value & "-" & MyText
1   Next ii
    Worksheets(MyRange.Worksheet.Name).Cells(i, NumberColumn).Value = Left(MyText, Len(MyText) - 1)
    MyText = ""
  Next i
End If
Exit Sub

YourMistake:
If Err = 424 Then
  Exit Sub
ElseIf Err = 5 Then
  Resume Next
Else
  MsgBox Err.Description
End If
End Sub

مرفق الملف :

بالتوفيق

Integrate.zip

[skyblue]

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

استاذي محمد حجازي اولا شكرا على التعديل على الملف . ثانيا عندما اضغط على

integrate تظهر لي رسالة بتحديد المجال فقمت بتحديد المجال كالاتي : a2:b2

ثم موافق واقوم نيحديد رقم العامود اللي ارغب ان تكون النتيجة فية فاحدد D2 فعندما اضغط موافق تظهر لي الرسالة التالية ( من غير الممكن ان يكون رقم العامود اصغر من الواحد الصحيح ) . ماالحل ؟

وشكرا

[محمد حجازي]

السلام عليكم ...

لاحظ أخي الكريم أن الرسالة الأولى تطلب منك تحديد مجال أما الرسالة الثانية فتطلب منك تحديد رقم.

أي عند ظهور الرسالة الأولى حدد مجال الدمج وعند ظهور الرسالة الثانية أدخل رقم العامود الذي تريد ظهور النتائج فيه ، فمثلاً عند كتابة الرقم 5 فإن الكود يقوم بوضع نتيجة الدمج في الخلايا المقابلة للخلايا الأصلية وذلك في العامود الخامس E . جرب كتابة رقم العامود (وعدم إدخال مجال) في رسالة الإدخال الثانية و أخبرني بالنتيجة.

بالتوفيق

[skyblue]

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

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

فاستاذي محمد حجازي = تخصص وابداع بلا حدود .

فيارب احفظ محمد حجازي ويسر له امره وبارك عليه على هذا العلم الذي ينتفع به ويقدمه للناس .

وتقبل تحياتي

[skyblue]

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

استاذي الفاضل :

الكود اكثر من ممتاز ولكن عندي ملاحظة بسيطة جدا وهي ( عندما اغير الورقة واجعلها من اليسار الى اليمين وهذا اللي انا استخدمه دائما يتغير الرقم كالاتي :

- A - B - C

111-225 225 111

الرقم بعد الدمج يظهر في الخلية C حسب الكود

انا أرغب ان يكون هناك تعديل في الكود ليصبح الرقم كالاتي : 225-111

اي يتم الدمج من اليسار الى اليمين

وشكرا لكم

[محمد حجازي]

السلام عليكم ...

بدل السطر التالي من الكود السابق :

For ii = MyRange.Column To MyRange.Column + MyRange.Columns.Count - 1

بالسطر:

For ii = MyRange.Column + MyRange.Columns.Count - 1 To MyRange.Column Step -1

تحياتي

[skyblue]

مشكور الله يعطيك العافية