Question

我在下面的代码块中出现内存不足错误。有没有人看到明显的原因？

编辑代码以显示整个块。最终这会遍历一个目录，但在工作之前我只会查看一个文件。

Sub Get_BT_Data()
Dim fNameAndPath, data As Variant
Dim j, c, r As Integer

fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSM), *.XLSM",     Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub

Workbooks.Open Filename:=fNameAndPath

Sheets("Summary For CDP").Activate
j = Range("A2").Value
c = Range("B2").Value
data = Range("DataRay")

ThisWorkbook.Activate

r = Cells(7, 4).End(xlDown).Row

For i = 7 To r
If Cells(i, 4).Value = j Then
    If Cells(i, 4).Offset(0, 1).Value = c Then
        Cells(i, 4).Offset(0, 3).Value = data(9, 20)
        Cells(i, 4).Offset(0, 4).Value = data(22, 22)
        Cells(i, 4).Offset(0, 7).Value = data(2, 20)
        Cells(i, 4).Offset(0, 8).Value = data(15, 22)
        Cells(i, 4).Offset(0, 10).Value = data(5, 20)
        Cells(i, 4).Offset(0, 11).Value = data(18, 22)
        Cells(i, 4).Offset(0, 13).Value = data(3, 22)
        Cells(i, 4).Offset(0, 14).Value = data(16, 22)
        Cells(i, 4).Offset(0, 16).Value = data(4, 20) + data(6, 20)
        Cells(i, 4).Offset(0, 17).Value = data(17, 22) + data(19, 22)
        Cells(i, 4).Offset(0, 19).Value = data(7, 20)
        Cells(i, 4).Offset(0, 20).Value = data(20, 22)
    Else
        If i = r Then
            Cells(7, 4).End(xlDown).Offset(-2, 0).EntireRow.Insert
        Else
        End If
    End If
Else
End If
Next i

End Sub

Answer 1

尝试检查r的值

将r = Cells(7, 4).End(xlDown).Row更改为以下内容可能有所帮助。

r = Cells(Rows.count, 4).End(xlUp).Row

此行相同

Cells(7, 4).End(xlDown).Offset(-2, 0).EntireRow.Insert

使用XlDown可能会有危险，因为如果您的列中有空白，或者如果第7行下方没有数据，您可能会错过值，那么它将返回工作表底部的行。我怀疑在这种情况下可能会发生这种情况。

通常最佳做法是在您尝试查找最后一行数据时从表格底部开始。

此外，

您应该查看"DataRay"范围有多大，尝试将其替换为适当的范围而不是命名范围，

将Range("DataRay")更改为Range("A1:E500")

如果您想检查DataRay范围的大小，可以在代码开头使用以下内容进行调试

MsgBox Range("DataRay").Rows.Count & " Rows " & Range("DataRay").Columns.Count & " Columns"

内存不足错误VBA - Excel

1 个答案: