在Excel和VBA中合併行

我想在Excel中合併行：要合併的內容可以位於不同列中，在我的示例中爲「C」或「D」。任何方式，我可以做到這一點使用VBA？該文件具有〜20k行。在Excel和VBA中合併行

我的文件：http://i.imgur.com/yDPdaQC.png

file

目標：http://i.imgur.com/SZ5t9oX.png

file

編輯更多的細節：

一些句子來自C & D列被分成2,3列，有時是4列。當「A」和「B」有一個值時，我想將這些字符串合併到它們各自列的「頂部」單元格中。

感謝您的幫助！

來源

2016-03-01 Sam

，並通過合併你的意思是結合到表？ – JamTay317

請發佈您迄今爲止編寫的代碼。請注意，SO不提供服務來爲您編寫VBA代碼。我們很樂意幫助其他VBA程序員編寫他們自己的代碼。 – Ralph

不，合併「單張」上的行內容！輸出可以在新的工作表上。請參閱示例/ C＆D專欄 – Sam

你可以使用這個。

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

來源

2016-03-01 17:52:30 JamTay317

你能澄清嗎？您是否想要：

創建合併單元格：C1與D1，C2與D2等？這會丟失D列的內容。
獲取D列中的文本並將它們追加到C列單元格的末尾;
創建其中包含了C + d附加文本

來源

2016-03-01 18:18:12

事情是這樣的一個新列：

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

來源

2016-03-01 23:27:47

在Excel和VBA中合併行

回答

相關問題