四列表（x，y，z，值）到matrix表
我想将四列中的数据转换为matrix表。 我试图使用OFFSETfunction，它的工作原理，但我的数据太大（约100,000细胞），它崩溃。
所以，我喜欢试图通过macros来做到这一点，你可以build议如何做到这一点？ 或者你有更好的build议。
PS。 我在这里使用了这个网站的OFFSET公式。
有趣的问题！ 因为你的数据大小有问题，所以我尽量避免使用像字典这样的对象（我不知道字典可以容纳多less）。 相反，我创build了一个跟踪很less数据的程序，但是最终不断地从文件中读取/写入：它会非常慢，但是它可以处理非常大的文件。
无论如何，请尝试将以下代码复制并粘贴到VBA模块中，然后在您的文件上运行它。 您可能需要更改行和列的一些值。
编辑：我做了你给的例子图片，但它是一团糟。 （g2g）我会尽量明确一点
编辑：它已经更新！ 仔细评论等，这将是很容易修改，但你喜欢。
概要
- 在数据表下build立matrix表
- 遍历数据表的行并将其添加到matrix表中
- 如果matrix表中没有数据的行或列，则使其成为现有的
例： 
代码:( SO摆脱空白:(我认为我的post太长）
'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
用ROWS上面齿轮的types，COLUMNS的颜色和ΣVALUES的总和：
隐藏顶部行，以表格forms显示报告布局，删除所有小计和总计，重新排列列和行的顺序，将空单元格设置为0 ，隐藏展开/折叠button，重复所有项目标签设置*和添加边框。
为了显示0行，我添加了总线/绿色/手动源数据（颜色（绿色），以避免（空白）作为额外的列）。
*在Excel 2007中不可用。要为Excel 2010之前的版本重复项目标签，标准做法是复制PT和select性粘贴特殊值，并通过select“转到特殊”，“空白”然后= ，向上， Ctrl + 回车