Optimize code to minimize runtime of the macro

后端 未结 2 1770
孤街浪徒
孤街浪徒 2021-01-26 03:10

I have been writing some macros to perform some astrological calculations (calculating sign, lunar mansion, D9 & D60). The raw data is in the following format:

相关标签:
2条回答
  • 2021-01-26 03:28

    There are a couple of things you can do. First of all, declaring all variable saves memory which in turn saves time. That being said, the real time consuming factor in your code is the looping through each cell. The fastest way to obtain the same result is to read the data into an array and then write the array to the output sheet. In the following code, I have edited your prepareOutput sub in such a way, that it keeps your initial code structure, but instead of looping through and writing to each cell, it now reads the data into an array and then writes this array to the desired output area.

    Sub prepareOutput()
        Application.ScreenUpdating = False
        Dim c As Range, d As Range, l As Range, ll As Range, r As Range
        Dim count As Integer
        Dim ArrDim As Integer, CurrVal As Integer
        Dim OutRng As Range
        Dim TempArr() As String
    
        'Defines worksheets
        Dim WsEmph As Worksheet, WsOut As Worksheet
        Set WsEmph = ActiveWorkbook.Sheets("Ephemerides")
        Set WsOut = ActiveWorkbook.Sheets("Output")
    
        Set r = WsEmph.Range("a4:" & Worksheets("Ephemerides").Range("a4").End(xlDown).Address)
    
        WsOut.Range("a3").Value = "Date"
        For Each d In r
            WsOut.Cells(d.Row, 1).Value = d.Value
        Next
    
        For Each c In WsEmph.Range("d2:o2")
            If Not IsEmpty(c) Then
                count = count + 5
    
                'Redimension of temporary array
                ArrDim = WsEmph.Range(c.Offset(2, 0), c.End(xlDown)).Rows.count
                ReDim TempArr(1 To ArrDim, 1 To 2)
                CurrVal = 1
    
                If count = 5 Then
                    With WsOut
                        .Cells(2, 2).Value = c.Value
                        .Cells(3, 2).Value = "Longitude"
                        .Cells(3, 3).Value = "Sign"
                        .Cells(3, 4).Value = "Nakshatra"
                        .Cells(3, 5).Value = "Navamsa"
                        .Cells(3, 6).Value = "D60"
                    End With
    
                    For Each l In WsEmph.Range(c.Offset(2, 0), c.End(xlDown).Address)
                        'Fills array
                        TempArr(CurrVal, 1) = l.Value
                        TempArr(CurrVal, 2) = calcSign(l.Value)
                        CurrVal = CurrVal + 1
                    Next
                        'Sets output range and writes data
                        Set OutRng = WsOut.Range(WsOut.Cells(c.Offset(2, 0).Row, 2), WsOut.Cells(c.End(xlDown).Row, 3))
                        OutRng = TempArr
                        count = 2
                Else
                    With WsOut
                        .Cells(2, count).Value = c.Value
                        .Cells(3, count).Value = "Longitude"
                        .Cells(3, count + 1).Value = "Sign"
                        .Cells(3, count + 2).Value = "Nakshatra"
                        .Cells(3, count + 3).Value = "Navamsa"
                        .Cells(3, count + 4).Value = "D60"
                    End With
    
                    For Each ll In WsEmph.Range(c.Offset(2, 0), c.End(xlDown).Address)
                        'Fills array
                        TempArr(CurrVal, 1) = ll.Value
                        TempArr(CurrVal, 2) = calcSign(ll.Value)
                        CurrVal = CurrVal + 1
                    Next
                        'Sets output range and writes data
                        Set OutRng = WsOut.Range(WsOut.Cells(c.Offset(2, 0).Row, count), WsOut.Cells(c.End(xlDown).Row, count + 1))
                        OutRng = TempArr
                End If
            End If
        Next
        Application.ScreenUpdating = True
    End Sub
    

    On my system, running your code took 25.16 seconds. With the above changes to the code it now takes just 3.16 seconds to perform the same task.

    Note that I have also declared all variables and used worksheet-variables as refference to each worksheet. All though the latter doesn't improve speed, it only improves the readability of the code.

    0 讨论(0)
  • 2021-01-26 03:52

    Here are some tips that will make a huge difference to your code execution time:

    1. Use Option Explicit and declare your variables as the most appropriate date type - only use Variant when you need to.
    2. Store your data a numbers (not strings) and use cell format to display as you want
    3. Don't loop over (large) ranges. Copy the range data to a variant array, and loop the array. Copy the result back to the sheet at the end. There is lots of examples of this on SO and elsewhere.

    To display a number as Deg Minutes Seconds use number format [h]°mm'ss\" This leverages the time format, so you need to create the number value as Deg/24 + Min/1440 + Sec/86400 Eg 293°44'23" has the value 12.2391550925926

    0 讨论(0)
提交回复
热议问题