Объединить строки в Excel & VBA

Question

Я хочу объединить строки в Excel: содержимое для объединения может быть в разных столбцах «C» или «D» в моем примере. Как я могу это сделать с помощью VBA? Файл имеет ~ 20 тыс. Строк.

Мой Файл:http://i.imgur.com/yDPdaQC.png

Цель:http://i.imgur.com/SZ5t9oX.png

Редактировать более подробную информацию:

Некоторые предложения из столбцов C & D разделены на 2,3, а иногда и на 4 строки. Я хотел бы объединить эти строки в «верхней» ячейке из своего соответствующего столбца, когда значения «А» и «В» имеют значение.

Благодарим за помощь!

Answer 1

вы можете использовать это.

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

Можете уточнить? Вы пытаетесь:

• Создать объединенные ячейки: C1 с D1, C2 с D2 и т. Д.? Это потеряет содержимое столбца D.
• Возьмите тексты в столбце D и добавьте их в конец ячеек столбца C;
• Создать новый столбец, который содержит C + D добавляются тексты

Answer 3

Что-то вроде этого:

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