在其他列中复制数据的同时将行转换为单列
我从SQL中提取数据，并且需要将某些行转换到列中，同时复制该表中唯一的其他数据。需要一个公式来读取所有列并粘贴新行和复制数据。 这只是一个例子，取决于我需要在一列中移动多less行的日子。 原始数据是在50,000以上行欢迎任何build议
之前
Order Line Item Day Day2 Day3 Day4 Day5 Day6 Day7 2000 1 Apple Mon Tue Wed Fri Sat Sun 2000 2 Orange Mon Thu Sun etc... 后
Order Line Item Day 2000 1 Apple Mon 2000 1 Apple Tue 2000 1 Apple Wed 2000 1 Apple Fri 2000 1 Apple Sat 2000 1 Apple Sun 2000 2 Orange Mon 2000 2 Orange Thu 2000 2 Orange Sun
这是一个快速和肮脏的方式来做到这一点。 这可能需要几分钟的时间才能运行，但这是多less行处理。
50,000×7 = 350,000行，所以如果您有最新版本的Excel，则可以将输出放在另一个工作表上。 我在2010年，行限额为1,048,576。
这假定数据在Sheet1上，我们将它写出到Sheet2。
在你的VBA IDE中，进入工具菜单并select引用。 select“Microstoft ActiveX数据对象2.8库”。
Private Sub CommandButton1_Click() Dim ws As Excel.Worksheet Dim rs As New ADODB.Recordset Dim lRow As Long 'Add fields to your recordset for storing data. This is how we will store the original data so we can process it after we read it. With rs .Fields.Append "Order", adInteger .Fields.Append "Line", adInteger .Fields.Append "Item", adChar, 25 .Fields.Append "Day", adChar, 10 .Fields.Append "Day2", adChar, 10 .Fields.Append "Day3", adChar, 10 .Fields.Append "Day4", adChar, 10 .Fields.Append "Day5", adChar, 10 .Fields.Append "Day6", adChar, 10 .Fields.Append "Day7", adChar, 10 .Open End With lRow = 2 'Start at two if there is a header row... Set ws = ActiveWorkbook.Sheets("Sheet1") ws.Activate 'Loop through the rows and record the data Do While lRow <= ws.UsedRange.Rows.count If ws.Range("A" & lRow).Value <> "" Then rs.AddNew rs.Fields("Order").Value = ws.Range("A" & lRow).Value rs.Fields("Line").Value = ws.Range("B" & lRow).Value rs.Fields("Item").Value = ws.Range("C" & lRow).Value rs.Fields("Day").Value = ws.Range("D" & lRow).Value rs.Fields("Day2").Value = ws.Range("E" & lRow).Value rs.Fields("Day3").Value = ws.Range("F" & lRow).Value rs.Fields("Day4").Value = ws.Range("G" & lRow).Value rs.Fields("Day5").Value = ws.Range("H" & lRow).Value rs.Fields("Day6").Value = ws.Range("I" & lRow).Value rs.Fields("Day7").Value = ws.Range("J" & lRow).Value rs.Update End If lRow = lRow + 1 ws.Range("A" & lRow).Activate Loop 'Switch to the second worksheet Set ws = Nothing Set ws = ActiveWorkbook.Sheets("Sheet2") ws.Activate lRow = 1 If rs.RecordCount > 0 Then rs.MoveFirst End If Do While rs.EOF = False If Trim(rs.Fields("Day").Value) <> "" Then ws.Range("A" & lRow).Value = rs.Fields("Order").Value ws.Range("B" & lRow).Value = rs.Fields("Line").Value ws.Range("C" & lRow).Value = rs.Fields("Item").Value ws.Range("D" & lRow).Value = rs.Fields("Day").Value lRow = lRow + 1 End If If Trim(rs.Fields("Day2").Value) <> "" Then ws.Range("A" & lRow).Value = rs.Fields("Order").Value ws.Range("B" & lRow).Value = rs.Fields("Line").Value ws.Range("C" & lRow).Value = rs.Fields("Item").Value ws.Range("D" & lRow).Value = rs.Fields("Day2").Value lRow = lRow + 1 End If If Trim(rs.Fields("Day3").Value) <> "" Then ws.Range("A" & lRow).Value = rs.Fields("Order").Value ws.Range("B" & lRow).Value = rs.Fields("Line").Value ws.Range("C" & lRow).Value = rs.Fields("Item").Value ws.Range("D" & lRow).Value = rs.Fields("Day3").Value lRow = lRow + 1 End If If Trim(rs.Fields("Day4").Value) <> "" Then ws.Range("A" & lRow).Value = rs.Fields("Order").Value ws.Range("B" & lRow).Value = rs.Fields("Line").Value ws.Range("C" & lRow).Value = rs.Fields("Item").Value ws.Range("D" & lRow).Value = rs.Fields("Day4").Value lRow = lRow + 1 End If If Trim(rs.Fields("Day5").Value) <> "" Then ws.Range("A" & lRow).Value = rs.Fields("Order").Value ws.Range("B" & lRow).Value = rs.Fields("Line").Value ws.Range("C" & lRow).Value = rs.Fields("Item").Value ws.Range("D" & lRow).Value = rs.Fields("Day5").Value lRow = lRow + 1 End If If Trim(rs.Fields("Day6").Value) <> "" Then ws.Range("A" & lRow).Value = rs.Fields("Order").Value ws.Range("B" & lRow).Value = rs.Fields("Line").Value ws.Range("C" & lRow).Value = rs.Fields("Item").Value ws.Range("D" & lRow).Value = rs.Fields("Day6").Value lRow = lRow + 1 End If If Trim(rs.Fields("Day7").Value) <> "" Then ws.Range("A" & lRow).Value = rs.Fields("Order").Value ws.Range("B" & lRow).Value = rs.Fields("Line").Value ws.Range("C" & lRow).Value = rs.Fields("Item").Value ws.Range("D" & lRow).Value = rs.Fields("Day7").Value lRow = lRow + 1 End If ws.Range("A" & lRow).Activate rs.MoveNext Loop End Sub
也许你可以修改你的SQL查询来直接使用UNION返回结果，例如？ ：
SELECT 'Order', Line, Item, Day1 AS Day FROM Table1 as T1 WHERE NOT IsNull(Day1) UNION SELECT 'Order', Line, Item, Day2 AS Day FROM Table1 WHERE NOT IsNull(Day2) UNION SELECT 'Order', Line, Item, Day3 AS Day FROM Table1 WHERE NOT IsNull(Day3) UNION SELECT 'Order', Line, Item, Day4 AS Day FROM Table1 WHERE NOT IsNull(Day4) UNION SELECT 'Order', Line, Item, Day5 AS Day FROM Table1 WHERE NOT IsNull(Day5) UNION SELECT 'Order', Line, Item, Day6 AS Day FROM Table1 WHERE NOT IsNull(Day6) UNION SELECT 'Order', Line, Item, Day7 AS Day FROM Table1 WHERE NOT IsNull(Day7)