内存不足错误VBA - Excel

I'm getting an out of memory error on the following block of code. Does anyone see an obvious reason why?

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

Edited the code to show entire block. eventually this will loop through a directory, but until working I'll only look at one file.

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

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

1 个解决方案

#1

Try checking what the value of r is

尝试检查r的值是什么

changing r = Cells(7, 4).End(xlDown).Row to the below may help.

改变r =细胞（7,4）.End（xlDown）。如下所示可能有所帮助。

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

Same for this line

这条线也一样

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

Using XlDown can be dangerous as you could either miss values if you have blanks in your column, or if you have no data below row 7, then it will return the row at the bottom of the sheet. I suspect this may be happening in this case.

使用XlDown可能很危险，因为如果列中有空格，或者如果第7行下面没有数据，则可能会丢失值，然后它将返回工作表底部的行。我怀疑在这种情况下可能会发生这种情况。

It's usually best practice to start at the bottom of the sheet when you're trying to find the last row of data.

当您尝试查找最后一行数据时，通常最好从工作表底部开始。

Also,

也，

You should check out how big your "DataRay" range is, try substituting it for a proper range rather than a named range,

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

change Range("DataRay") to something like Range("A1:E500")

将范围（“DataRay”）更改为Range（“A1：E500”）

If you want to check the size of your DataRay range then you could use the following at the start of your code to debug

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

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

#1