[英]Excel VBA merge multiple columns into one on separate rows
I have an excel 2007 worksheet open with 5 colums and +/-5000 rows of data. 我有一个Excel 2007工作表,其中有5个列和+/- 5000行数据。
What I want to do is create a macro that will: 我想做的是创建一个宏,该宏将:
I am pulling out my hair trying to accomplish this but to no avail! 我正在拔头发试图做到这一点,但无济于事! please could someone assist me with this?
请有人可以帮助我吗?
Much thanks 非常感谢
Pass the worksheet to this particular function. 将工作表传递给此特定功能。 It's not a complicated thing to do - I'd be interested to know what was going wrong with your approaches (it would have been good to post sample code in your question).
这不是一件复杂的事情-我很想知道您的方法出了什么问题(将示例代码发布在您的问题中会很好)。
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
Try something like this 试试这个
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
How about: 怎么样:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.