Question

我有两个程序，由于我在Excel中设置的数据超出了大量的内存而内存不足。

Sub format()
Dim x, Y(), i&, j&, k&, s

x = Range("A1", Cells(1, Columns.count).End(xlToLeft)).Value
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 1 To UBound(x, 2)
    .Item(x(1, i)) = i
Next i

x = Application.Trim(Range("BL3", Cells(Rows.count, "BL").End(xlUp)).Value)
ReDim Y(1 To UBound(x), 1 To .count): j = 1

For i = 1 To UBound(x)
    If InStr(x(i, 1), "==") = 0 Then
        s = Split(x(i, 1))

        If .Exists(s(0)) Then
        k = .Item(s(0)): Y(j, k) = mid(x(i, 1), Len(s(0)) + 2)
        End If
    Else
        j = j + 1
    End If
Next i
End With

[a2].Resize(j, UBound(Y, 2)).Value = Y()

End Sub

以上是我用来将一列数据拆分/修剪成多行/列的过程。

我把数据分成两列，每列包含60k行，我需要做的就是一旦读取BL，读取BO并继续它离开的地方将第二行数据放在新行的下面第一个完成了

Answer 1

像这样的东西（UNTESTED）可能适合你。它避免了使用较小尺寸的块创建巨大的2D阵列。

Sub format()

Const BLOCK_SIZE As Long = 10000
Dim x, Y(), i&, j&, k&, s
Dim d As Object
Dim rOffset As Long
Dim xCount As Long

    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = 1

    x = Range("A1", Cells(1, Columns.Count).End(xlToLeft)).Value
    For i = 1 To UBound(x, 2)
          'using Add: you probably want this to error if duplicates exist...
          d.Add x(1, i), i         
    Next i

    x = Application.Trim(Range("BL3", Cells(Rows.Count, "BL").End(xlUp)).Value)
    xCount = UBound(x)
    rOffset = 0

    ReDim Y(1 To BLOCK_SIZE, 1 To d.Count)
    j = 1

    For i = 1 To xCount
        If InStr(x(i, 1), "==") = 0 Then
            s = Split(x(i, 1))

            If d.Exists(s(0)) Then
                k = d(s(0))
                Y(j, k) = Mid(x(i, 1), Len(s(0)) + 2)
            End If
        Else
            j = j + 1
            If j > BLOCK_SIZE Then
                [a2].Offset(rOffset, 0).Resize(BLOCK_SIZE, d.Count).Value = Y()
                ReDim Y(1 To BLOCK_SIZE, 1 To d.Count)
                j = 1
                rOffset = rOffset + BLOCK_SIZE
            End If
        End If
    Next i

    [a2].Offset(rOffset, 0).Resize(BLOCK_SIZE, d.Count).Value = Y()

End Sub

打破一个大的Excel程序

1 个答案: