รวมหลายแถวเข้าด้วยกัน

ฉันกำลังพยายามรวมข้อมูลหลายแถวเข้าด้วยกัน คอลัมน์ A มีค่าที่การจัดกลุ่มจะเป็นไปตามนั้น - แถวที่ค่าของคอลัมน์ A ตรงกันจะรวมกันเป็นหนึ่งแถว ช่วงของฉันขยายจากคอลัมน์ A ถึง X ดังนั้นฉันต้องการแถวข้อมูลที่ตรงกันเพื่อเริ่มในคอลัมน์ Y

ตัวอย่าง:

╔══════╦═══╦═══╗
║ 1001 ║ A ║ C ║
║ 1001 ║ B ║ D ║
║ 1002 ║ A ║ E ║
║ 1002 ║ B ║ F ║
║ 1002 ║ C ║ G ║
╚══════╩═══╩═══╝

ผลลัพธ์ที่ต้องการ:

╔══════╦═══╦═══╦═══╦═══╦═══╦═══╗
║ 1001 ║ A ║ C ║ B ║ D ║   ║   ║
║ 1002 ║ A ║ E ║ B ║ F ║ C ║ G ║
╚══════╩═══╩═══╩═══╩═══╩═══╩═══╝

รหัส VBA ที่ฉันใช้อยู่ในขณะนี้ไม่ได้นำเนื้อหาทั้งหมดของแถวที่ตรงกัน มันจะใช้ข้อมูลในคอลัมน์ที่ 2 และเลื่อนขึ้น

รหัส VBA:

Sub Mergeitems()

    Dim cl As Range
    Dim rw As Range

    Set rw = ActiveCell

    Do While rw <> ""
        ' for each row in data set
        '   find first empty cell on row
        Set cl = rw.Offset(0, 1)
        Do While cl <> ""
            Set cl = cl.Offset(0, 1)
        Loop

        ' if next row needs to be processed...
        Do While rw = rw.Offset(1, 0)
            cl = rw.Offset(1, 1)       ' move the data
            Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
            rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data
        Loop

        ' next row
        Set rw = rw.Offset(1, 0)
    Loop
End Sub

ฉันอาจเข้าใกล้ปัญหาทั่วไปของคุณ (การรวมแถว) กับมาโครที่แตกต่างกันโดยสิ้นเชิง แต่นี่คือบรรทัดที่คุณอาจต้องการเปลี่ยนในรหัสของคุณ:

cl = rw.Offset(1, 1)       ' move the data
Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data

ลองแทนที่ด้วย:

i = 1
Do While rw.Offset(1, i) <> "" 
    cl = rw.Offset(1, i)      
    Set cl = cl.Offset(0, 1)  
    i = i + 1
Loop
rw.Offset(1, 0).EntireRow.Delete xlShiftUp  'delete old data

ผล: