بلانك قام بنشر مارس 21, 2022 مشاركة قام بنشر مارس 21, 2022 دمج صفوف مثال.xlsx رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مارس 21, 2022 مشاركة قام بنشر مارس 21, 2022 Sub Test() Dim m As Long, r As Long, n As Long Application.ScreenUpdating = False With ActiveSheet m = .Cells(Rows.Count, 1).End(xlUp).Row n = 1 .Columns("K:M").WrapText = True For r = 1 To m Step 2 .Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value) n = n + 1 Next r End With Application.ScreenUpdating = True End Sub 1 رابط هذا التعليق شارك More sharing options...
بلانك قام بنشر مارس 21, 2022 الكاتب مشاركة قام بنشر مارس 21, 2022 شكرا جزيلا على الرد والكود وزادك الله علما ونفعا للاخرين واطمع في طلب بسيط تعديل الكود لدمج ثلاث صفوف وشكرا مقدما رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مارس 21, 2022 مشاركة قام بنشر مارس 21, 2022 Use your mind please. Study the code well Think of dealing with the three rows by changing the step from step 2 to step 3 and change the code according this رابط هذا التعليق شارك More sharing options...
بلانك قام بنشر مارس 21, 2022 الكاتب مشاركة قام بنشر مارس 21, 2022 عملت الاتي ولم يفلح فأنا لست متخصص في الاكواد عذرا : For r = 1 To m Step 3 رابط هذا التعليق شارك More sharing options...
lionheart قام بنشر مارس 21, 2022 مشاركة قام بنشر مارس 21, 2022 Try to get this line well .Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value) I didn't ask you to write a whole code, just understand the code to be able to modify it 1 رابط هذا التعليق شارك More sharing options...
بلانك قام بنشر مارس 22, 2022 الكاتب مشاركة قام بنشر مارس 22, 2022 اشكرك على تعبك معي ولكن مازال الكود لايضم 3 صفوف وهذا هو الكود بعد التعديل : ( )Sub Test Dim m As Long, r As Long, n As Long Application.ScreenUpdating = False With ActiveSheet m = .Cells(Rows.Count, 1).End(xlUp).Row n = 1 .Columns("K:M").WrapText = True For r = 1 To m Step 3 .Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value) .Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value) n = n + 1 Next r End With Application.ScreenUpdating = True End Sub دمج3 صفوف.xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة lionheart قام بنشر مارس 22, 2022 أفضل إجابة مشاركة قام بنشر مارس 22, 2022 That's great you have tried that's a great step towards learning Sub Test() Dim m As Long, r As Long, n As Long Application.ScreenUpdating = False With ActiveSheet m = .Cells(Rows.Count, 1).End(xlUp).Row n = 1 .Columns("K:M").WrapText = True For r = 1 To m Step 3 .Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value & vbLf & .Range("A" & r + 2).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value & vbLf & .Range("B" & r + 2).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value & vbLf & .Range("C" & r + 2).Value) n = n + 1 Next r End With Application.ScreenUpdating = True End Sub 2 رابط هذا التعليق شارك More sharing options...
بلانك قام بنشر مارس 22, 2022 الكاتب مشاركة قام بنشر مارس 22, 2022 احسنت وزادك اله علما لتنفع به الاخرين امثالي 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان