这可能在某处,我错过了,请告诉我。
运行我的宏后,我得到运行时错误7内存不足。经过调试,它就在这一行:
cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N1").Value
该代码旨在运行具有经度和纬度的机场列表,创建将被解释为圆圈的线段,并转换为.KML(由Google地球专业版读取)。
以下是代码的其余部分 - 如何清理这样的内容以避免内存泄漏?
所有答案都赞赏,或指向其他帖子。我知道这很多,所以也欢迎一般的建议!谢谢!
Sub PLANEMAN_Coords()
Dim Latitude As Double
Dim Longitude As Double
Dim Bearing As Integer
Dim LeftRight As Integer
Dim RangeKM As Double
Dim MinRange As Double
For Each cell In [RangeRings_ENTER!B9:B5001]
If cell.Value = "" Then
GoTo EXITLOOP
Else
End If
Latitude = cell.Offset(0, 1)
Longitude = cell.Value
'set default values:
'line width
If cell.Offset(0, 2).Text = "" Then
cell.Offset(0, 2).Value = 2
'default line width = 2
Else
End If
'radius
If cell.Offset(0, 5).Text = "" Then
cell.Offset(0, 5).Value = 8.04672
'default radius = 8.04672 km = 5 miles
Else
End If
RangeKM = cell.Offset(0, 5)
'line color
If cell.Offset(0, 3).Text = "" Then
cell.Offset(0, 3).Value = "ff0000ff"
'default line color is Red
Else
End If
'common code
Sheets("MakeRing_Maths").Range("D3").Value = Longitude
Sheets("MakeRing_Maths").Range("E3").Value = Latitude
Sheets("MakeRing_Maths").Range("D1").Value = RangeKM
'code that differs depending on range-ring type
If cell.Offset(0, 7).Text = "Circle" Then
Sheets("MakeRing_Maths").Range("J1").Value = 0 'Bearing
Sheets("MakeRing_Maths").Range("J2").Value = 180 'width - ie 2 x 180 = 360 = complete circle
Calculate
cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N1").Value
Else
'else wedge of some sort
Bearing = cell.Offset(0, 8)
LeftRight = cell.Offset(0, 9)
MinRange = cell.Offset(0, 10)
Sheets("MakeRing_Maths").Range("J1").Value = Bearing
Sheets("MakeRing_Maths").Range("J2").Value = LeftRight
If cell.Offset(0, 7).Text = "Wedge" Then
Calculate
cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N2").Value
Else 'else a wedge with minimum range component 'Wedge2
If cell.Offset(0, 7).Text = "Wedge2" Then
Sheets("MakeRing_Maths").Range("F1").Value = MinRange
Calculate
cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N3").Value
Else
If cell.Offset(0, 7).Text = "Arrow" Then
Sheets("MakeRing_Maths").Range("F1").Value = RangeKM * 0.95
Calculate
cell.Offset(0, 6).Select 'just so that the user can 'see' that the macro is still running and not crashed
cell.Offset(0, 6).Value = Sheets("MakeRing_Maths").Range("N4").Value
Else
'HERE
End If
End If
End If
End If
Next
EXITLOOP:
Call PLANEMAN_RangeRings_KML 'make KML file
End Sub
Sub PLANEMAN_RangeRings_KML()
' Original inspiration code by simon_a
' Planeman 2009
'get user to specify save location and name
Dim ThisAddress As String
ChDir ThisWorkbook.Path
ThisAddress = Application.GetSaveAsFilename(FileFilter:="KML Files (*.kml),*.kml", Title:="Save Location & Name")
' file details
filePath = ThisAddress
docName = "PLANEMAN.KML"
FolderName = "Folder"
Open filePath For Output As #1
'Write header to file
outputText = "<?xml version=""1.0"" encoding=""UTF-8""?> <kml xmlns=""http://www.opengis.net/kml/2.2"" xmlns:gx=""http://www.google.com/kml/ext/2.2"" xmlns:kml=""http://www.opengis.net/kml/2.2"" xmlns:atom=""http://www.w3.org/2005/Atom""> <Document><name>" & docName & "</name> <Folder> <name>" & FolderName & "</name> <open>1</open>"
Print #1, outputText
'loop
For Each cell In [RangeRings_ENTER!B9:B5001]
If cell.Value = "" Then
Exit For
End If
StrPart1 = "<Style id=""sn_ylw-pushpin""><IconStyle><color>" & cell.Offset(0, 3) & "</color></IconStyle><LineStyle><width>" & cell.Offset(0, 2) & "</width><color>" & cell.Offset(0, 3) & "</color></LineStyle><PolyStyle><color>" & cell.Offset(0, 3) & "</color></PolyStyle></Style>"
StrPart2 = "<Placemark><name>" & cell.Offset(0, -1) & "</name> <styleUrl>#sn_ylw-pushpin</styleUrl> <LineString> "
StrPart3 = "<coordinates>" & cell.Offset(0, 6) & ",0 </coordinates> </LineString></Placemark>"
'Create a placemark
outputText = StrPart1 & StrPart2 & StrPart3
Print #1, outputText
Next
'Write footer to file
outputText = "</Folder></Document></kml>"
Print #1, outputText
Close #1
MsgBox "Macro Complete"
'
End Sub
Sub PLANEMAN_Placemarks_KML()
' Original inspiration code by simon_a
' Planeman 2009
'get user to specify save location and name
Dim ThisAddress As String
ChDir ThisWorkbook.Path
ThisAddress = Application.GetSaveAsFilename(FileFilter:="KML Files (*.kml),*.kml", Title:="Save Location & Name")
' file details
filePath = ThisAddress
docName = "PLANEMAN.KML"
FolderName = "PlacemarkFolder"
Open filePath For Output As #1
'Write header to file
outputText = "<?xml version=""1.0"" encoding=""UTF-8""?><kml xmlns=""http://www.opengis.net/kml/2.2""> <Document><name>" & docName & "</name> <Folder> <name>" & FolderName & "</name> <open>1</open>"
Print #1, outputText
'loop
For Each cell In [Placemarks_ENTER!B9:B5001]
If cell.Value = "" Then
Exit For
End If
StrPart1 = ""
StrPart2 = " <Placemark> <name> " & cell.Offset(0, -1) & " </name> "
StrPart3 = cell.Offset(0, 6) & "<Point><coordinates> " & cell.Offset(0, 0) & "," & cell.Offset(0, 1) & ",0</coordinates> </Point> </Placemark>"
'Create a placemark
outputText = StrPart1 & StrPart2 & StrPart3
Print #1, outputText
Next
'Write footer to file
outputText = "</Folder></Document></kml>"
Print #1, outputText
Close #1
MsgBox "Macro Complete"
'
End Sub
答案 0 :(得分:3)
非常感谢您的回答,我找到了解决方案!
原来一个简单的解决办法是截断一些数字,因为它们非常大(15个十进制数字),现在它就像一个魅力一样。
感谢您的时间!
<强> UPATE:强>
始终要在代码中添加Option Explicit
并明确声明变量。您可以按照以下步骤进行配置,以便编辑器自动添加此行。通过这种方式,您可以了解并能够管理变量,处理与其内存分配相关的数据类型。
一个。在Visual Basic编辑器中,单击“工具”,然后单击“选项”。
湾检查需要变量声明。
对于VBA编译器而言,通过更多表达错误消息(例如,值太大)而不是普通的旧一般内存不足,这将是非常好的像这样。无论如何,以下是解释导致此错误的可能原因的链接。
您打开了太多应用程序,文档或源文件。关 任何不必要的应用程序,文档或源文件 开。
您的模块或程序太大。
将大型模块或程序分解为较小的模块或程序。这不会节省内存,但可以防止达到64K段边界。
您正在以标准模式运行Microsoft Windows。以增强模式重新启动Microsoft Windows。
您正在以增强模式运行Microsoft Windows,但虚拟内存已用完。通过释放一些磁盘来增加虚拟内存 空间,或至少确保有一些空间可用。
您正在运行终止和驻留程序。消除终止和驻留程序。
您加载了许多设备驱动程序。消除不必要的设备驱动程序。
Publicvariables
的空间不足减少公共变量的数量。
(1)Excel specifications and limits.
(2)Numeric precision in Microsoft Excel.
VBA内的准确性 虽然Excel名义上默认使用8字节数字,但VBA有 各种数据类型。 Double数据类型是8个字节,即Integer 数据类型是2个字节,而通用的是16个字节的Variant数据 可以使用VBA将类型转换为12字节的十进制数据类型 转换函数CDec。[16]在VBA中选择变量类型 计算涉及考虑存储要求,准确性 和速度。