VBA代码优化

时间:2017-10-05 08:22:03

标签: excel vba excel-vba optimization

我在VBA中有代码并且有大量行使用太多内存 - 它可能需要几GB并且可以粉碎。代码取数请求服务器为XLM查找一些数据并写入它们而不是转到另一个数字。如果有超过500行粉碎。你能帮助我优化代码来处理大约10 000行吗? 谢谢您的帮助 马立克

Sub ares()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False 'potlačí obnovování obrazovky
Application.DisplayAlerts = False 'potlačí varovné hlášky
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim i As Integer
Dim row As Integer
Dim column As Integer

For i = 2 To 15000

    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares"
    Sheets("ares").Activate

    On Error GoTo ErrorHandler
    ActiveWorkbook.XmlImport URL:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_bas.cgi?ico=" & Worksheets("ico").Cells(i, 1).Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

    If Worksheets("ares").Cells(2, 10).Value = "" Then

        Worksheets("ico").Cells(i, 2).Value = "OK"


        row = 2
        column = 3
        Do While Worksheets("ares").Cells(row, 1).Value <> ""
            If Worksheets("ares").Cells(row, 167).Value <> "" Then
                Worksheets("ico").Cells(i, column).Value = Worksheets("ares").Cells(row, 167).Value
                column = column + 1
            End If

        row = row + 1
        Loop
    Else
        Worksheets("ico").Cells(i, 2).Value = Worksheets("ares").Cells(2, 10).Value
    End If
ErrorResume:

    Sheets("ares").Delete

Next i

Application.ScreenUpdating = True 'zapne obnovování obrazovky
Application.DisplayAlerts = FaTruelse 'obnoví varovné hlášky
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True


Exit Sub
ErrorHandler:
    Worksheets("ico").Cells(i, 2).Value = "Jiná chyba"
Resume ErrorResume

End Sub

1 个答案:

答案 0 :(得分:0)

删除Sheets("ares").Activate并将Integer更改为Long。这应该足够了。

只要您在任何地方正确引用工作表,就不需要激活工作表。

关于整数,它会给你一个小的加速 - Why Use Integer Instead of Long?