Excel VBA將多列合並為單獨的一行

Question

我有一個Excel 2007工作表，其中有5個列和+/- 5000行數據。

我想做的是創建一個宏，該宏將：

1. 在每條記錄下插入3個空白行
2. 將值復制到第1列的該行中，然后將其粘貼到第1列的3個新行中
3. 從第3列中截取值，並將其放在第2列中其下方的第一空白行中
4. 從第4列中剪切出該值，並將其放在第2列中它下方的下一個空白行中
5. 從第5列中剪切出該值，並將其放在第2列中它下方的下一個空白行中

我正在拔頭發試圖做到這一點，但無濟於事！ 請有人可以幫助我嗎？

非常感謝

Answer 1

將工作表傳遞給此特定功能。 這不是一件復雜的事情-我很想知道您的方法出了什么問題（將示例代碼發布在您的問題中會很好）。

Public Sub splurge(ByVal sht As Worksheet)

    Dim rw As Long
    Dim i As Long

    For rw = sht.UsedRange.Rows.Count To 1 Step -1
        With sht
            Range(.Rows(rw + 1), .Rows(rw + 3)).Insert
            For i = 1 To 3
                ' copy column 1 into each new row
                .Cells(rw, 1).Copy .Cells(rw + i, 1)
                ' cut column 3,4,5 and paste to col 2 on next rows
                .Cells(rw, 2 + i).Cut .Cells(rw + i, 2)
            Next i
        End With
    Next rw

End Sub

Answer 2

試試這個

Sub Macro1()
Dim range As range
Dim i As Integer

Dim RowCount As Integer
Dim ColumnCount As Integer
Dim sheet As worksheet
Dim tempRange As range
Dim valueRange As range
Dim insertRange As range

    Set range = Selection
    RowCount = range.Rows.Count
    ColumnCount = range.Columns.Count
    For i = 1 To RowCount
        Set sheet = ActiveSheet

        Set valueRange = sheet.range("A" & (((i - 1) * 4) + 1), "E" & (((i - 1) * 4) + 1))

        Set tempRange = sheet.range("A" & (((i - 1) * 4) + 2), "E" & (((i - 1) * 4) + 2))
        tempRange.Select
        tempRange.Insert xlShiftDown
        Set insertRange = Selection
        insertRange.Cells(1, 1) = valueRange.Cells(1, 1)
        insertRange.Cells(1, 2) = valueRange.Cells(1, 3)
        valueRange.Cells(1, 3) = ""

        Set tempRange = sheet.range("A" & (((i - 1) * 4) + 3), "E" & (((i - 1) * 4) + 3))
        tempRange.Select
        tempRange.Insert xlShiftDown
        Set insertRange = Selection
        insertRange.Cells(1, 1) = valueRange.Cells(1, 1)
        insertRange.Cells(1, 2) = valueRange.Cells(1, 4)
        valueRange.Cells(1, 4) = ""

        Set tempRange = sheet.range("A" & (((i - 1) * 4) + 4), "E" & (((i - 1) * 4) + 4))
        tempRange.Select
        tempRange.Insert xlShiftDown
        Set insertRange = Selection
        insertRange.Cells(1, 1) = valueRange.Cells(1, 1)
        insertRange.Cells(1, 2) = valueRange.Cells(1, 5)
        valueRange.Cells(1, 5) = ""

    Next i
End Sub

Answer 3

怎么樣：

Dim cn As Object
Dim rs As Object

strFile = Workbooks(1).FullName
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT t.F1, t.Col2 FROM (" _
       & "SELECT F1, 1 As Sort, F3 As Col2 FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT F1, 2 As Sort, F4 As Col2 FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT F1, 3 As Sort, F5 As Col2 FROM [Sheet1$] ) As t " _
       & "ORDER BY F1, Sort"

rs.Open strSQL, cn

Worksheets("Sheet6").Cells(2, 1).CopyFromRecordset rs