☰

我怎样才能自动实现这种重新排序？

tag-icon • tag-icon microsoft-excel worksheet-function sorting import
我怎样才能自动实现这种重新排序？

我有（来自 CVS 文件的）以下格式的数据：

数据是一个连续的列表（一行一行的逗号分隔值），其中可以在任意位置插入或删除列。在这些情况下，会添加一个新的“标题”行。第一列始终是日期。直接导入将如下所示：

数据源表格式

现在，我需要进一步的数据评估如下的表格： 所需数据表格式

由于我有大量这种格式的数据，因此手动重新排列不是一种选择。

我怎样才能自动实现这种重新排序？

是通过从 CVS 文件查询导入到 Excel，还是通过后续的 Excel 操作？

答案1

从计算机和关系数据库理论的角度来看，将混合数据转换为以下形式要好得多：

新表格形式

通过以下脚本可以相当快速地完成这项工作：

Option Explicit

Sub repackMixedData()
Dim sheet As Worksheet
Dim rSource As Range
Dim rRow As Range
Dim rHeader As Range
Dim oCellDate As Range
Dim oCell As Range
Dim oTargetCell As Range
    Set sheet = ActiveSheet
    Set rSource = sheet.UsedRange
    Set sheet = ThisWorkbook.Worksheets.Add()
    Set oTargetCell = sheet.Range("A1")
    With oTargetCell.Resize(1, 3)
        .Value = Array("Date", "Item", "Value")
        .Font.Bold = True
    End With
    For Each rRow In rSource.Rows
        Set oCellDate = rRow.Cells(1)
        If oCellDate = "Date" Then
            Set rHeader = rRow
        Else
            For Each oCell In rRow.Offset(0, 1).Cells
                If Not IsEmpty(oCell) Then
                    Set oTargetCell = oTargetCell.Offset(1, 0)
                    oTargetCell.Value2 = oCellDate.Value2
                    oTargetCell.NumberFormat = oCellDate.NumberFormat
                    oTargetCell.Offset(0, 1) = rHeader.Cells(1, oCell.Column).Text
                    oTargetCell.Offset(0, 2) = oCell.Value
                End If
            Next oCell
        End If
    Next rRow
End Sub

利用生成的“平面”表，您可以做任何事，例如创建一个数据透视表并获得类似于第二张屏幕截图的结果。

更新由于实际数据比预期的多得多，因此宏已略有改进。请尝试此选项 - 它应该会快一点。

Sub repackMixedData2()
Dim sheet As Worksheet
Dim rSource As Range
Dim rRow As Range
Dim rHeader As Range
Dim oCellDate As Range
Dim oCell As Range
Dim countOfValues As Long
Dim arrResult As Variant
Dim index As Long
    Set sheet = ActiveSheet
    Set rSource = sheet.UsedRange
    countOfValues = Application.WorksheetFunction.CountA(rSource.Offset(0, 1))
ReDim arrResult(1 To countOfValues, 1 To 3) As Variant
    index = 1
    arrResult(index, 1) = "Date"
    arrResult(index, 2) = "Item"
    arrResult(index, 3) = "Value"
    For Each rRow In rSource.Rows
        Set oCellDate = rRow.Cells(1)
        If oCellDate = "Date" Then
            Set rHeader = rRow
        Else
            For Each oCell In rRow.Offset(0, 1).Cells
                If IsEmpty(oCell) Then Exit For
                index = index + 1
                arrResult(index, 1) = oCellDate.Value2
                arrResult(index, 2) = rHeader.Cells(1, oCell.Column).Text
                arrResult(index, 3) = oCell.Value
            Next oCell
        End If
    Next rRow
    
    Set sheet = ThisWorkbook.Worksheets.Add()
    sheet.Range("A1:C" & index).Value2 = arrResult
    sheet.Range("A1:C1").Font.Bold = True
    sheet.Range("A:A").NumberFormat = oCellDate.NumberFormat
End Sub

相关内容