我写了一些代码，在开始日期和结束日期之间分配月费。当我在46次迭代中执行它时，它工作得很好（这意味着计算了48个不同的订阅）。但是，在迭代编号46之后，它返回运行时错误。 有没有人知道如何使代码更有效率或如何延长＆＃34;运行时间段＆＃34;在Excel？如果代码运行1分钟，它仍然可以。
这是我的代码：
Sub CalcualteDistribution()
Dim c As Range
For Each c In Worksheets("Table2").Range("C2", Range("C2").End(xlDown))
If Not IsEmpty(c.Value) Then
Call MonthlyDistribution(c)
End If
Next c
End Sub
Sub MonthlyDistribution(c As Range)
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
'Amount for months with 30 days
Dim amount30 As Double
'Amount for months with 31 days
Dim amount31 As Double
'Amount for february
Dim amountFeb As Double
Dim price As Double
Dim numberDays As Integer
Dim count As Range
Dim jan, feb, mar, apr, may, jun, jul, aug, sep, oct, nov, dec As Double
jan = 0
feb = 0
mar = 0
apr = 0
may = 0
jun = 0
jul = 0
aug = 0
sep = 0
oct = 0
nov = 0
dec = 0
Set count = c
FirstDate = count.Value
LastDate = count.Offset(0, 13).Value
NextDate = FirstDate
price = count.Offset(0, 14).Value
numberDays = count.Offset(0, 17).Value
amount30 = price / 30
amount31 = price / 31
amountFeb = price / 28
amountFebSchalltjahr = price / 29
While NextDate <= LastDate
If Month(NextDate) = 1 Then
jan = jan + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 2 Then
feb = feb + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 3 Then
mar = mar + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 4 Then
apr = apr + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 5 Then
may = may + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 6 Then
jun = jun + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 7 Then
jul = jul + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 8 Then
aug = aug + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 9 Then
sep = sep + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 10 Then
oct = oct + 1
NextDate = NextDate + 1
ElseIf Month(NextDate) = 11 Then
nov = nov + 1
NextDate = NextDate + 1
Else
dec = dec + 1
NextDate = NextDate + 1
End If
Wend
count.Offset(0, 1).Value = jan * amount31
count.Offset(0, 2).Value = feb * amountFeb
count.Offset(0, 3).Value = mar * amount31
count.Offset(0, 4).Value = apr * amount30
count.Offset(0, 5).Value = may * amount31
count.Offset(0, 6).Value = jun * amount30
count.Offset(0, 7).Value = jul * amount31
count.Offset(0, 8).Value = aug * amount31
count.Offset(0, 9).Value = sep * amount30
count.Offset(0, 10).Value = oct * amount31
count.Offset(0, 11).Value = nov * amount30
count.Offset(0, 12).Value = dec * amount31
End Sub
答案 0 :(得分：0)
注意：这几乎肯定不会解决运行时错误的问题根源。但是 会显着提高代码质量，从而提高效率。所以这是对＆＃34;是否有人知道如何使代码更有效...＆＃34;
Sub CalcualteDistribution()
Dim cell As Range
With ThisWorkbook.Worksheets("Table2")
For Each cell In .Range("C2").Resize(.Range("C2").End(xlDown).Row)
If Not IsEmpty(cell.Value) Then
MonthlyDistribution cell
End If
Next cell
End With
End Sub
Sub MonthlyDistribution(ByVal InputCell As Range)
' Default value of `Double` is 0, so no need to explicitly set the value to 0.
Dim Months(1 To 12) As Double
Dim FirstDate As Date
FirstDate = InputCell.Value
Dim LastDate As Date
LastDate = InputCell.Offset(0, 13).Value
Dim price As Double
price = InputCell.Offset(0, 14).Value
' Use Long over Integer
'Dim numberDays As Integer
Dim numberDays As Long
numberDays = InputCell.Offset(0, 17).Value
'Amount for months with 30 days
Dim amount30 As Double
amount30 = price / 30
'Amount for months with 31 days
Dim amount31 As Double
amount31 = price / 31
'Amount for february
Dim amountFeb As Double
amountFeb = price / 28
' Note that you dont actually use this anywhere
amountFebSchalltjahr = price / 29
Dim NextDate As Date
NextDate = FirstDate
While NextDate <= LastDate
Months(Month(NextDate)) = Months(Month(NextDate)) + 1
NextDate = NextDate + 1
Wend
Dim i As Long
For i = 1 To 12
Select Case i
Case 1, 3, 5, 7, 8, 10, 12
InputCell.Offset(0, i).Value = Months(i) * amount31
Case 4, 6, 9, 11
InputCell.Offset(0, i).Value = Months(i) * amount30
Case 2
InputCell.Offset(0, i).Value = Months(i) * amountFeb
End Select
Next
End Sub
我只进行了一些调整，但理想情况下这将使您的代码更易于阅读和维护。值得指出的第一件事是我使你的变量略微更具描述性。我将c更改为cell，将c MonthlyDistribution更改为InputCell。从那里开始，代码使用InputCell而不是创建指针的副本（没有必要）。我还删除了Call的弃用用法。
使用参数调用子例程时，只需使用以下语法：SubName arg1, arg2, arg3...。
当有返回（例如函数）时，您需要使用括号：Foo = FunctionName(arg1, arg2, arg3...)
我没有为每个月创建月份变量（jan，feb，mar等），而是使用了Months数组。这使您的代码可预测。注意当你只修改一个值时，如果不需要丑陋的if / else-if。我当然没有反对if陈述，但我很少使用超过一两个ElseIf。如果我发现自己这样做了，我会使用Select Case或者进一步抽象我的代码。
最后，在重新编写值时，我只需要Select Case来选择30天，31天或28天的费率。理想情况下，编写一个处理确定一个月内天数的函数会更好（因为尽管为闰年制作了一个变量，但你从不使用它）。这超出了我的答案范围。
最终重构像这样的代码应该可以更容易地弄清楚发生了什么，并且它也应该更容易维护代码。
现在，在消除该错误的来源之后，我会先检查这一行：
Worksheets("Table2").Range("C2", Range("C2").End(xlDown))因为这依赖于ActiveWorkbook以及ActiveSheet（对于第二个范围调用）。要解决这些问题，请尝试以下方法：
With ThisWorkbook.Worksheets("Table2")
For Each cell In .Range("C2").Resize(.Range("C2").End(xlDown).Row)
If Not IsEmpty(cell.Value) Then
MonthlyDistribution cell
End If
Next cell
End With
请注意，现在工作表由ThisWorkbook限定（即代码运行的工作簿），第二个Range引用由With ...子句限定。最后，我明确地将范围调整到最后一行（这也适用于.End(xlUp)。这些措施降低了这是问题根源的可能性。
这只会让您的日期成为问题的根源。坦率地说，我没有足够的时间来处理日期，但是如果你的日期导致了问题，你要么有一个隐含的日期转换（如果它不能在Date变量中读取值如此解释，或者您试图以不起作用的方式执行日期添加。如果OP中没有其他细节，我会从这里猜测。
采取以下步骤改进您的代码，看看您是否可以解决问题。如果没有，请更新您的答案并提供更多详细信息，我们可以尽我们所能提供帮助。
答案 1 :(得分：0)
这必须是VBA吗？这可以通过公式完成。在你的＆＃34;表2＆＃34;工作表，在单元格D2中，使用此公式，然后复制到列O并向下复制您所拥有的行数：
=IF(AND($C2<DATE(YEAR($C2),COLUMN(A2)+1,1),$P2>=DATE(YEAR($C2),COLUMN(A2),1)),(MIN(EOMONTH(DATE(YEAR($C2),COLUMN(A2),1),0),$P2)-MAX(DATE(YEAR($C2),COLUMN(A2),1),$C2)+1)*($Q2/DAY(EOMONTH(DATE(YEAR($C2),COLUMN(A2),1),0))),"")
或者，如果绝对必须是VBA，那么这对您有用：
Sub tgr()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Table2")
With ws.Range("C2", ws.Cells(ws.Rows.Count, "C").End(xlUp)).Offset(, 1).Resize(, 12)
If .Row < 2 Then Exit Sub 'No data
.Formula = "=IF(AND($C2<=DATE(YEAR($C2),COLUMN(A2)+1,1),$P2>=DATE(YEAR($C2),COLUMN(A2),1)),(MIN(EOMONTH(DATE(YEAR($C2),COLUMN(A2),1),0),$P2)-MAX(DATE(YEAR($C2),COLUMN(A2),1),$C2)+1)*($Q2/DAY(EOMONTH(DATE(YEAR($C2),COLUMN(A2),1),0))),"""")"
.Value = .Value
End With
End Sub