将行转置为单列，同时复制其他列中的数据

Question

我正在从 SQL 中提取数据，需要将一些行转置到列中，同时复制其他唯一的数据 table 需要一个公式来读取所有列并粘贴新行和复制数据。这只是一个例子，具体取决于我需要在一列中转置尽可能多的行的日子。原始数据超过 50,000 行欢迎任何建议

之前

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

Answer 1

这是一种快速而肮脏的方法。运行这可能需要几分钟，但这就是处理那么多行所需要的时间。

50,000x7 = 350,000 行，因此如果您有 Excel 的任何最新版本，您可以将输出放在另一个工作表上。我在 2010 年，行数限制为 1,048,576。

这假设数据在 Sheet1 上，我们将把它写到 Sheet2。

在您 VBA IDE 中转到工具菜单和 select 参考。 Select“Microsoft 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

Answer 2

也许您可以修改 SQL 查询，例如使用 UNION 直接 return 结果？ :

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)

将行转置为单列，同时复制其他列中的数据

Transposing rows into a single column while copying data in other columns

excel

vba

transpose