vba将数据排序为矩阵形式

我有一些数据，对于第一列日期，它包含两个日期

然后是基金代码和类别，最后一列是类别值

---

如何将它们转换为矩阵格式，例如，类别是水平的，值对应于基金名称、类别和日期。

以下代码应该会有所帮助

Option Explicit

Sub Demo()
    With Application
        .ScreenUpdating = False             'stop screen flickering
        .Calculation = xlCalculationManual  'prevent calculation while execution
    End With

    Dim i As Long, lastrow As Long, tblLastRow As Long, tblLastColumn As Long
    Dim dict As Object
    Dim rng As Variant
    Dim ws As Worksheet
    Dim cel As Range, dateRng, fundCodeRng As Range, categoryRng As Range, valueRng As Range

    Set dict = CreateObject("Scripting.Dictionary")
    Set ws = ThisWorkbook.Worksheets("Sheet1")  'change Sheet1 to your worksheet

    With ws
        lastrow = .Range("A" & .Rows.Count).End(xlUp).Row   'get last row with data
        'set ranges for date, fund code, category and value to be used later in code
        Set dateRng = .Range("A2:A" & lastrow)
        Set fundCodeRng = .Range("B2:B" & lastrow)
        Set categoryRng = .Range("C2:C" & lastrow)
        Set valueRng = .Range("D2:D" & lastrow)

        'get unique records for date and fund coding combined together
        For i = 2 To lastrow
            dict(.Cells(i, 1).Value & "|" & .Cells(i, 2).Value) = dict(.Cells(i, 1).Value & "|" & .Cells(i, 2).Value)
        Next

        With .Range("F2").Resize(dict.Count)    'date and fund code will be displayed from cell F2
            .Value = Application.Transpose(dict.Keys)
            .TextToColumns Destination:=.Cells, DataType:=xlDelimited, Other:=True, OtherChar:="|"
            .Offset(, 2).Resize(dict.Count).Value = Application.Transpose(dict.Items)
        End With

        'empty dictionary
        dict.RemoveAll
        Set dict = Nothing
        Set dict = CreateObject("Scripting.Dictionary")

        'get unique categories and display as header
        rng = .Range("C1:C" & lastrow)
        For i = 2 To UBound(rng)
            dict(rng(i, 1) & "") = ""
        Next
        .Range("H1").Resize(1, UBound(dict.Keys()) + 1).Value = dict.Keys   'categories will be displayed from column H

        tblLastRow = .Range("F" & Rows.Count).End(xlUp).Row             'get last row in new table
        tblLastColumn = Cells(1, Columns.Count).End(xlToLeft).Column    'get last column of category in new table

        'display corresponding values for date, fund code and category
        For Each cel In .Range(.Cells(2, 8), .Cells(tblLastRow, tblLastColumn)) 'Cells(2, 8) represent Cell("H2")
            cel.FormulaArray = "=IFERROR(INDEX(" & valueRng.Address & ",MATCH(1,(" & dateRng.Address & "=" & .Cells(cel.Row, 6) & ")*(" & fundCodeRng.Address & "=""" & .Cells(cel.Row, 7) & """)*(" & categoryRng.Address & "=""" & .Cells(1, cel.Column) & """),0)),"""")"
            cel.Value = cel.Value
        Next cel

    End With

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

请参阅图片以获取参考

编辑：

---

如果基金代码也可以是数字，则替换

cel.FormulaArray = "=IFERROR(INDEX(" & valueRng.Address & ",MATCH(1,(" & dateRng.Address & "=" & .Cells(cel.Row, 6) & ")*(" & fundCodeRng.Address & "=""" & .Cells(cel.Row, 7) & """)*(" & categoryRng.Address & "=""" & .Cells(1, cel.Column) & """),0)),"""")"

与

---

非常感谢您的阅读和帮助。这是存储数据的最佳屏幕布局或最佳结构。你能上传一些问题的截图吗？我想在A栏显示（你可以参考我的问题图片），显示一个日期，在第2栏显示基金代码，然后类别是标题，然后发布相应的值。谢谢你，请帮助我用公式解算你行吗？是的，我赞同你的回答，顺便说一句，我如何显示两个平行日期的数据。因此，我无法更好地进行比较。还有一个错误是，当基金名称为所有数字时，如123456，排序将不会显示结果，而留下空白区域。@HKU\U Johnny\U QFin-请参阅我答案中的编辑。对于

如何显示两个平行日期的数据，您需要提供更多详细信息。非常感谢。我希望实现的是，对于一个日期，数据将在列中发布（在本例中，从F到L），我希望另一个数据的数据显示在列之后L@HKU_Johnny_QFin-这是一项巨大的工作。需要为您所要求的内容编写全新的逻辑。
cel.FormulaArray = "=IFERROR(INDEX(" & valueRng.Address & ",MATCH(1,(" & dateRng.Address & "=" & .Cells(cel.Row, 6) & ")*(Text(" & fundCodeRng.Address & ",""0"")=""" & .Cells(cel.Row, 7) & """)*(" & categoryRng.Address & "=""" & .Cells(1, cel.Column) & """),0)),"""")"