Question

基本上代码的作用是，它在行中查找重复值并将相应的值转换为列。该代码适用于少量行。问题是我有很多包含600,000多行数据的电子表格。现在当我选择所有数据并运行代码时，它会给我＆＃34;运行时错误＆＃39; 7＆＃39;：Out of Memory＆＃34;错误。

调试器突出显示的行是：

ReDim Preserve xArr1(1 To UBound(xArr1, 1), 1 To xArr2(1) + t - 1)

这是整个VBA代码：

Sub ConvertTable()
Update 20150113
Dim xArr1 As Variant
Dim xArr2 As Variant
Dim InputRng As Range, OutRng As Range
Dim xRows As Long
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
xArr1 = InputRng.Value
t = UBound(xArr1, 2): xRows = 1
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 2 To UBound(xArr1, 1)
        If Not .exists(xArr1(i, 1)) Then
            xRows = xRows + 1: .Item(xArr1(i, 1)) = VBA.Array(xRows, t)
            For ii = 1 To t
                xArr1(xRows, ii) = xArr1(i, ii)
            Next
        Else
            xArr2 = .Item(xArr1(i, 1))
            If UBound(xArr1, 2) < xArr2(1) + t - 1 Then
                ReDim Preserve xArr1(1 To UBound(xArr1, 1), 1 To xArr2(1) + t - 1)
                For ii = 2 To t
                    xArr1(1, xArr2(1) + ii - 1) = xArr1(1, ii)
                Next
            End If
            For ii = 2 To t
                xArr1(xArr2(0), xArr2(1) + ii - 1) = xArr1(i, ii)
            Next
            xArr2(1) = xArr2(1) + t - 1: .Item(xArr1(i, 1)) = xArr2
        End If
    Next
End With
OutRng.Resize(xRows, UBound(xArr1, 2)).Value = xArr1
End Sub

信用：我从here找到了原始的VBA代码。

感谢您的帮助。

Answer 1

<强> 解决方案：
安装Excel 64位，Excel 32位无法处理该内存量
的声明
虽然this question基本上具有相同的内存问题，但实际解决方案（此处提供的解决方案）可能会令人困惑。如果您想讨论这个答案是否应该删除，请在下面的评论中进行评论。

运行时错误＆＃39; 7＆＃39;。尝试运行VBA代码时内存不足

1 个答案: