表格的四列（x，y，z，值）到矩陣表

Question

我想將四列中的數據轉換為矩陣表。 我試過使用OFFSET功能，它可以工作，但我的數據太大（大約100,000個單元格），它崩潰了。

所以，我想通過宏來嘗試這樣做，你能建議怎么做嗎？ 或者你有更好的建議，那將是偉大的。

PS。 我在這里使用了這個網站的OFFSET公式。

Answer 1

與ROWS上面的齒輪類型相對應，列的顏色和Σ值的總和：

隱藏頂行，報表布局以表格形式顯示，刪除所有小計和總計，重新排列列和行的順序，設置為顯示0空單元格，隱藏展開/折疊按鈕，重復所有項目標簽集* ，以及邊界添加。

為了顯示0秒的行，我在源數據中添加了Bus / Green / Manual（使用顏色（綠色）以避免（空白）作為額外列）。

---

*在Excel 2007中不可用的版本重復項目標簽比Excel 2010中的標准做法是將PT復制和粘貼特殊，價值與按轉到特殊，選擇它們填補空白早期空白，然后= ，上， 按Ctrl + 輸入

Answer 2

有趣的問題！ 因為您遇到涉及數據大小的問題，所以我試圖避免使用字典之類的對象（我不知道字典可以容納多少）。 相反，我創建了一個程序來跟蹤非常少的數據，但最終不斷地從文件讀取/寫入：它將非常慢，但它適用於非常大的文件。

無論如何，嘗試將以下代碼復制並粘貼到VBA模塊中，然后在您的文件上運行它。 您可能需要更改行和列的某些值。

編輯：我讓它為你給出的示例圖片工作，但它是一團糟。 我明天會試着讓它更清楚（g2g）
編輯：它已被更新！ 仔細評論等，無論你喜歡什么，都很容易修改。

摘要

• 在數據表下面構建矩陣表
• 循環遍歷數據表的行並將它們添加到矩陣表中
• 如果矩陣表中沒有數據的行或列，請創建它，否則放在現有數據中

例：

代碼：（SO擺脫了空白:(我認為我的帖子太長了）

'Start and end row of the original data
Private dataStartRow As Long
Private dataEndRow As Long

'The start row/column of the matrix
Private matrixStartRow As Long
Private matrixStartCol As Long

'How many rows/columns in the matrix
Private matrixRowLength As Long
Private matrixColLength As Integer

Public Sub makeMatrixTable()
    'Sets initial values for variables
    initializeValues
    'Builds table
    buildTable
End Sub

Private Function initializeValues()
    'The actual data probably begins on row 2, because row 1 is usually used for column titles
    dataStartRow = 2
    'Get last row of data
    dataEndRow = ActiveSheet.UsedRange.Rows.Count

    'By adding 2, we create a gap row between our new matrix table and the original data table
    matrixStartRow = dataEndRow + 2
    'The matrix values begin after column 2, because columns 1&2 are used for titles
    matrixStartCol = 2

    matrixRowLength = 0
    matrixColLength = 0
End Function

Private Function buildTable()
    Dim dataRow As Long
    Dim matrixRow As Long
    Dim matrixCol As Integer
    Dim value As String

    'The keys are the column/row titles
    'I'm using the work "key" because we're mimicking a dictionary object by only using a key once
    'in this case it's a little more complicated, as we have 3 keys (2 row keys, 1 column key)
    Dim rowKey1 As String, rowKey2 As String
    Dim colKey As String

    'loop through all rows containing data
    For dataRow = dataStartRow To dataEndRow
        'get keys from data
        rowKey1 = CStr(ActiveSheet.Cells(dataRow, 1).value)
        rowKey2 = CStr(ActiveSheet.Cells(dataRow, 3).value)
        colKey = CStr(ActiveSheet.Cells(dataRow, 2).value)

        'find if we have already created rows for the row keys, and if so return the row (else -1)
        matrixRow = rowExistsInMatrix(rowKey1, rowKey2)
        'find if we have already created a column for the column key, and if so return the row (else -1
        matrixCol = colExistsInMatrix(colKey)

        'Our matrix does not have a row with those row keys, so we must create one
        If matrixRow = -1 Then
            'increase the size of our matrix
            matrixRowLength = matrixRowLength + 1
            'get row that is not in use
            matrixRow = matrixStartRow + matrixRowLength
            'add the new keys to matrix
            ActiveSheet.Cells(matrixRow, 1).value = rowKey1
            ActiveSheet.Cells(matrixRow, 2).value = rowKey2
        End If

        'We don't have a column that matches the column key
        If matrixCol = -1 Then
            'increase size of matrix table
            matrixColLength = matrixColLength + 1
            'get column that is not in use
            matrixCol = matrixStartCol + matrixColLength
            'add new key to matrix
            ActiveSheet.Cells(matrixStartRow, matrixCol).value = colKey
        End If

        'get the value to be placed in the matrix from column 4
        value = CStr(ActiveSheet.Cells(dataRow, 4).value)
        'place value
        ActiveSheet.Cells(matrixRow, matrixCol).value = value

    Next dataRow
End Function

'Checks to see if the key from the data table exists in our matrix table
'if it does, return the row in the matrix table
'else return -1
Private Function rowExistsInMatrix(dataKey1 As String, dataKey2 As String) As Long
    Dim matrixRow As Long
    Dim matrixKey1 As String, matrixKey2 As String

    'loop through rows of matrix
    For matrixRow = matrixStartRow To matrixStartRow + matrixRowLength
        'get keys from matrix
        matrixKey1 = CStr(ActiveSheet.Cells(matrixRow, 1).value)
        matrixKey2 = CStr(ActiveSheet.Cells(matrixRow, 2).value)

        'do the keys match
        If dataKey1 = matrixKey1 And dataKey2 = matrixKey2 Then
            rowExistsInMatrix = matrixRow
            Exit Function
        End If
    Next matrixRow

    rowExistsInMatrix = -1
End Function

'Same as rowExistsInMatrix but loops through column titles
Private Function colExistsInMatrix(dataKey As String) As Long
    Dim matrixKey As String
    Dim matrixCol As Integer

    'loop through columns
    For matrixCol = matrixStartCol To matrixStartCol + matrixColLength
        matrixKey = CStr(ActiveSheet.Cells(matrixStartRow, matrixCol).value)

        'does a key match
        If matrixKey = dataKey Then
            colExistsInMatrix = matrixCol
            Exit Function
        End If
    Next matrixCol

    colExistsInMatrix = -1
End Function