优化代码以最大限度地减lessmacros的运行时间

我一直在写一些macros来执行一些占星术计算（计算符号，月亮大厦，D9和D60）。 原始数据格式如下：

上图中的lng代表度，分，秒格式表示的经度。 输出必须采用以下格式：

我掀起了下面的代码，从input表格中读取数据并格式化并复制到输出表格，然后用每个星球的经度计算出需要的字段。

Sub prepareOutput() Application.ScreenUpdating = False Dim c, count, d, l, ll Dim r As Range Set r = Worksheets("Ephemerides").Range("a4:" & Worksheets("Ephemerides").Range("a4").End(xlDown).Address) Worksheets("output").Range("a3").Value = "Date" For Each d In r Worksheets("output").Cells(d.Row, 1).Value = d.Value Next For Each c In Worksheets("Ephemerides").Range("d2:o2") If Not IsEmpty(c) Then count = count + 5 'MsgBox count If count = 5 Then Worksheets("output").Cells(2, 2).Value = c.Value Worksheets("output").Cells(3, 2).Value = "Longitude" Worksheets("output").Cells(3, 3).Value = "Sign" Worksheets("output").Cells(3, 4).Value = "Nakshatra" Worksheets("output").Cells(3, 5).Value = "Navamsa" Worksheets("output").Cells(3, 6).Value = "D60" For Each l In Worksheets("Ephemerides").Range(c.Offset(2, 0), c.End(xlDown).Address) Worksheets("output").Cells(l.Row, 2).Value = l.Value Worksheets("output").Cells(l.Row, 3).Value = calcSign(l.Value) Next count = 2 Else Worksheets("output").Cells(2, count).Value = c.Value Worksheets("output").Cells(3, count).Value = "Longitude" Worksheets("output").Cells(3, count + 1).Value = "Sign" Worksheets("output").Cells(3, count + 2).Value = "Nakshatra" Worksheets("output").Cells(3, count + 3).Value = "Navamsa" Worksheets("output").Cells(3, count + 4).Value = "D60" For Each ll In Worksheets("Ephemerides").Range(c.Offset(2, 0), c.End(xlDown).Address) Worksheets("output").Cells(ll.Row, count).Value = ll.Value Worksheets("output").Cells(ll.Row, count + 1).Value = calcSign(ll.Value) Next End If End If Next Application.ScreenUpdating = True End Sub Private Function deg2dec(deg As String) As Variant d = Val(Mid(deg, 1, InStr(deg, "°") - 1)) m = Val(Mid(deg, InStr(deg, "°") + 1, 2)) / 100 deg2dec = d + m End Function Private Function calcSign(deg As String) As String dec = deg2dec(deg) Select Case dec Case 0 To 30 calcSign = "Aries" Case 30 To 60 calcSign = "Taurus" Case 60 To 90 calcSign = "Gemini" Case 90 To 120 calcSign = "Cancer" Case 120 To 150 calcSign = "Leo" Case 150 To 180 calcSign = "Virgo" Case 180 To 210 calcSign = "Libra" Case 210 To 240 calcSign = "Scorpio" Case 240 To 270 calcSign = "Saggitarius" Case 270 To 300 calcSign = "Capricorn" Case 300 To 330 calcSign = "Aquarius" Case 330 To 360 calcSign = "Pisces" End Select End Function 

上面的代码不计算所有4个计算字段，现在只有一个。

我遇到的问题是，我的input表中有24000行和12列，只需要将这些数据复制到输出表中，然后对其进行计算以计算出一个值就可以了。从一个经度值计算3个字段。

所以，如果你们可以看一下代码，让我知道我怎么可以在这里最小化运行时间，这将有很大的帮助。

如果有人想看一下，这里是工作簿的链接。 astro.xlsm

预先感谢所有抽出时间回复的人。

干杯

Answer 1

有几件事你可以做。 首先，声明所有的variables节省内存，从而节省时间。 话虽如此，代码中的实时消耗因素是循环通过每个单元格。 获得相同结果的最快方法是将数据读入数组，然后将数组写入输出表。 在下面的代码中，我编辑了你的prepareOutput子程序，它保留了你的初始代码结构，而不是循环和写入到每个单元，现在它将数据读入一个数组，然后把这个数组写入所需的输出区域。

 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 

在我的系统上，运行你的代码需要25.16秒 。 通过对代码的上述更改，现在只需3.16秒即可执行相同的任务。

请注意，我也宣布所有variables和使用工作表variables作为参考每个工作表。 尽pipe后者并没有提高速度，但它只是提高了代码的可读性。

Answer 2

以下是一些对您的代码执行时间产生巨大影响的提示：

1. 使用Option Explicit并将variables声明为最合适的datetypes – 只在需要时使用Variant 。
2. 将您的数据存储一个数字（而不是string），并使用单元格格式来显示你想要的
3. 不要循环（大）范围。 将范围数据复制到variables数组，并循环数组。 将结果复制回最后的表格。 SO和其他地方有很多这样的例子。

要显示一个数字作为度分秒使用数字格式[h]°mm'ss\"这将利用时间格式，所以您需要创build数值为Deg/24 + Min/1440 + Sec/86400例如293°44'23"的值为12.2391550925926