在复制其他数据的同时将具有 ID 字段的某些列“转置”为行

Question

假设我在 Excel 中继承了一个处理流程和个人的表，该表（在其他数千行中）看起来与此类似。

ID             | Name        | Quality1   | Quality2   | ... | QualityN   |
...
234,014,828,423  James         Low          Hot           .    Blue
212,552,211      Mark          Low          Cold          .    Red
845              Amy           High         Hot           .    White
...

我打算稍后在 Access 中使用这些数据，作为一个参考表，其中每个 ID 号都是不同的，并且有相应的数据。第一步显然是使用Excel中的文本到列工具来分解ID类别。这给我们留下了看起来像这样的东西。

ID |   |   |   | Name        | Quality1   | Quality2   | ... | QualityN   |
... 
234 014 828 423  James         Low          Hot           .    Blue
212 552 211      Mark          Low          Cold          .    Red
845              Amy           High         Hot           .    White
...

然而，下一部分让我陷入困境。需要什么样的流程（仅使用 Excel、Access 和相关的 VBA）才能让我得到想要的结果？

ID             | Name        | Quality1   | Quality2   | ... | QualityN   |
... 
234              James         Low          Hot           .    Blue
014              James         Low          Hot           .    Blue
828              James         Low          Hot           .    Blue
423              James         Low          Hot           .    Blue
212              Mark          Low          Cold          .    Red
552              Mark          Low          Cold          .    Red
211              Mark          Low          Cold          .    Red
845              Amy           High         Hot           .    White
...

我的直觉告诉我在 Access 中逐位使用从 0 到 9999 到 JOIN 的数字表，但这是代码和时间密集型的，而且非常粗暴和不灵活。有没有更优雅的方法让我制定我的解决方案？

Answer 1

如果您想在 Excel 进入 Access 之前使用它来执行此操作，那么可以使用一个简单的嵌套 for 循环来抓取数据并放入另一个工作表中吗？

这个小函数可以做到这一点：

Option Explicit

Function Consolidate()

    Dim x As Long, y As Long, z As Long
    Dim OutputRow As Long, OutputCol As Long
    Dim MaxRow As Long, MaxIdCol As Long, MaxCol As Long
    Dim HomeSheet As String, NewSheet As String

    'Initialize
    MaxRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row 'Last row with an ID
    MaxIdCol = Cells(1, 1).End(xlToRight).Column - 1 ' Last column with an ID
    MaxCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column 'Last column overall
    HomeSheet = ActiveSheet.Name 'Where we start from
    NewSheet = Sheets.Add.Name 'Place to put new stuff
    OutputRow = 0 'Counter for where we're putting data

    'Loop over each row
    For x = 1 To MaxRow
        'Loop over each ID column in that row
        For y = 1 To MaxIdCol
            'Is there an ID in this cell?
            If Sheets(HomeSheet).Cells(x, y) <> "" Then
                'Reset loop variables
                OutputRow = OutputRow + 1
                OutputCol = 1
                'Drop the ID in
                Sheets(NewSheet).Cells(OutputRow, OutputCol) = Sheets(HomeSheet).Cells(x, y)
                'copy over the other values
                For z = MaxIdCol + 1 To MaxCol
                    OutputCol = OutputCol + 1
                    Sheets(NewSheet).Cells(OutputRow, OutputCol) = Sheets(HomeSheet).Cells(x, z)
                Next z
            End If
        Next y
    Next x

End Function