Question

我在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

Answer 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展示时，以帮助人们确定正在发生的事情。

Answer 2

问题与Excel版本有关。一旦我迁移到64位版本的Office 365，而不是以前的32位版本，一切都解决了。

Excel中宏的内存问题：如何解决此问题？

2 个答案: