我在Excel中的宏有问题。这里的代码。实际上,出于篇幅考虑,我没有报告很多潜艇。但是,最重要的是附件。
Sub randomdata_generator()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim FromProducts As Integer
Dim ToProducts As Integer
Dim StepProducts As Integer
Dim FromStations As Integer
Dim ToStations As Integer
Dim StepStations As Integer
FromProducts = Range("G1").Value
ToProducts = Range("I1").Value
StepProducts = Range("K1").Value
FromStations = Range("G2").Value
ToStations = Range("I2").Value
StepStations = Range("K2").Value
For h1 = FromProducts To ToProducts Step StepProducts
For h2 = FromStations To ToStations Step StepStations
Index = 0
For xx1 = 1 To 17 Step 1 'NC
x1 = h1
x2 = h2
Range("B1").Value = x1
D = Application.WorksheetFunction.Round(x1 * 0.1, 0)
E = Application.WorksheetFunction.Round(x1 * 0.2, 0)
BAEG = Application.WorksheetFunction.Round(x1 * 0.35, 0)
For xx2 = 1 To 5 Step 1
If x2 >= x1 Then GoTo prossimo
Range("B2").Value = x2
Range("B4").Value = 20 * x2 'D
For x3 = 1 To 5 'NI
Range("B3").Value = x3
If x3 > 1 Then
q = 3
Else
q = 1
End If
For g = 1 To q
x5 = 1
Range("B5").Value = x5
s = E
For i = 0 To s - 1
Range("A25").Offset(0, D + i).Value = 0.3
Range("A28").Offset(0, D + i).Value = 0.2
Range("A46").Offset(0, D + i).Value = 0.009
Next
Next
Next
Next
Next
Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
这是代码的一部分,用于保存已生成的新文件。
Sub salvanuovo()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wbkCurrent As Workbook
Index = Index + 1
If Index Mod 200 = 0 Then
newHour = Hour(Now())
newMinute = Minute(Now()) + 1
newSecond = Second(Now()) + 30
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
DoEvents
End If
ActiveWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm" 'example: "C:\Users\lucag\Desktop\randomdata_generator_alternativa\Dati(" & Index & ").xlsm"
Workbooks.Open Filename:=ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm"
Workbooks("Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm").Activate
Sheets("Foglio1").Select
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks("Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsx").Close
Kill (ThisWorkbook.Path & "\Data\Dati(" & (x1 / 10) & "_" & (x2) & "_" & Index & ").xlsm")
Set wbkCurrent = ActiveWorkbook
wbkCurrent.Activate
Set wbkCurrent = Nothing
End Sub
下图显示了问题。内存一直加载,直到Excel崩溃。关于如何解决此问题的任何提示。 enter image description here
没有.Copy或。粘贴仅分配的.Value
Selection.ClearContents
Range("A12").Select
答案 0 :(得分:1)
这不是一个全面的答案,只是一个开始。
首先,Excel VBA在内部将Integer
类型视为Long
。 This answer显示了更多信息。因此,我建议使用Long
,除非特定于旧版Excel版本的向后兼容性。
接下来,我看到您正在使用工作表功能。您不需要
D = Application.WorksheetFunction.Round(x1 * 0.1, 0)
,因为它可以简化为
D = Round(x1 * 0.1, 0)
最重要的是,您正在通过嵌套循环疯狂地访问工作表。我认为最好将VBA必须与范围或工作表进行交互的次数限制为最小次数,例如将值存储在数组中并将整个数组转储到单元格。
此外,您可以查看this answer有关内存问题的信息,因为这里有很多技巧可以适用。
总的来说,我建议使用更有意义的变量名,尤其是在向SO展示时,以帮助人们确定正在发生的事情。
答案 1 :(得分:0)
问题与Excel版本有关。一旦我迁移到64位版本的Office 365,而不是以前的32位版本,一切都解决了。