Question

我正在从SQL中提取数据，并且需要将某些行转换为列，同时复制该表唯一的其他数据需要一个公式来读取所有列并粘贴新行并复制数据。这只是一个例子，取决于我需要在一列中转换的行数。原始数据为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中，转到工具菜单并选择参考。选择“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

Answer 2

也许您可以修改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)

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

2 个答案: