合并Excel和VBA中的行

Question

I want to merge rows in Excel: the content to merge can be in different columns, "C" or "D" in my example. Any way I can do this using VBA? The file has ~20k rows.

My File: http://i.imgur.com/yDPdaQC.png

Goal: http://i.imgur.com/SZ5t9oX.png

Edit with more details:

Some sentences from the C & D columns are divided in 2,3 and sometimes 4 rows. I would like to merge those strings at the "top" cell from their respective column, when "A" and "B" have a value.

Thanks for your help!

Answer 1

you can use this.

Sub Merge()
    Dim ws As worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim ws2 As worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")

    Dim sheet2Rng As Range: Set sheet2Rng = ws2.UsedRange
    Dim startRow As Integer: startRow = LastRow(ws) + 1
    Dim ws2RowCount As Integer: sheet2Rng.Rows.Count

    ChangeEvents False
    ws.Range("A" & startRow).Resize(ws2RowCount, 4).value = sheet2Rng.value
    ChangeEvents True
End Sub

Public Function LastRow(worksheet As worksheet) As Integer
    LastRow = worksheet.Cells(Rows.Count, 1).End(xlUp).Row
End Function

Sub ChangeEvents(value As Boolean)
    Application.EnableEvents = value
End Sub

Answer 2

Can you clarify? Are you trying to:

• Create merged cells: C1 with D1, C2 with D2, etc? This will lose the contents of the D column.
• Take the texts in column D and append them to the end of the column C cells;
• Create a new column which contains the C + D appended texts

Answer 3

Something like this:

Sub SquishRows()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim rng As Range, rr As Range
    Dim rowdata As Variant
    Dim i As Integer, idx As Integer, j as Integer

    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")
    sh1.Activate

    Set rng = Range("A2").Resize(sh1.UsedRange.rows.Count - 1, sh1.UsedRange.Columns.Count)

    ReDim rowdata(Application.CountA(rng.Columns(1)), rng.Columns.Count - 1)

    idx = 0
    For i = 1 To rng.rows.Count
        Set rr = rng.rows(i)
        If Len(rr.Cells(1).Text) And Len(rr.Cells(2).Text) Then
            idx = idx + 1
            For j = 1 To rng.Columns.Count
                rowdata(idx, j - 1) = rr.Cells(j).Text
            Next
        Else
            For j = 3 To rng.Columns.Count
                If Len(rr.Cells(j).Text) Then
                    rowdata(idx, j - 1) = rowdata(idx, j - 1) & " " & rr.Cells(j).Text
                End If
            Next
        End If
    Next

    'push data to Sheet2
    sh2.Range("A1").Resize(UBound(rowdata, 1) + 1, UBound(rowdata, 2) + 1).Value = rowdata

    'add in header row
    sh2.Range(sh1.UsedRange.rows(1).Address).Value = sh1.UsedRange.rows(1).Value

    sh2.Activate
End Sub