VBA-导致此溢出错误的原因是什么?

时间:2020-07-29 17:03:19

标签: excel vba

我在VBA中遇到错误。就在我刚参加的几周之内,代码本身可能缺少很多最佳实践。

但是除此之外,在这种情况下,我在下一行收到Overflow错误

dateDifference = DateDiff("d", currentDate, olderDate, vbMonday)在该部分

'========================
'make cell BLUE
'========================

下面列出了完整的代码。有人知道吗,是什么原因导致这个问题?作为一个新角,我的猜测是,这与在循环中不断重新分配3个变量有关?

非常感谢。

Sub HrReporting_Step07_ApplyCellColouring()

ThisWorkbook.Activate

'========================
'Variables for looping
'========================
'declarations
Dim rowCount As Integer
Dim i As Integer
Dim srcColourColumnIntRed1 As Integer
Dim srcColourColumnIntRed2 As Integer
Dim srcColourColumnIntYellow As Integer
Dim srcColourColumnIntGreen As Integer
Dim srcColourColumnIntBlue1 As Integer
Dim srcColourColumnIntBlue2 As Integer
'variable declaration specifically for date calculations that are needed for colouring cells YELLOW or BLUE
Dim olderDate As Date
Dim currentDate As Date
Dim dateDifference As Integer

'assignments
srcColourColumnIntRed1 = Range("Table1[Availability Status]").Column
srcColourColumnIntRed2 = Range("Table1[Sum of Current Calendar % Allocated]").Column
srcColourColumnIntYellow = Range("Table1[Coming Available Category]").Column
srcColourColumnIntGreen = Range("Table1[CW-1]").Column
srcColourColumnIntBlue1 = Range("Table1[Current Calendar]").Column
srcColourColumnIntBlue2 = Range("Table1[Current Calendar End Date]").Column

rowCount = Range("Table1[Coming Available Category]").Count + 1

'========================
'make cell RED
'========================
For i = 2 To rowCount
'based on following conditions
'   1. Column "Sum of Current Calendar % Allocated" is lower or equal to 60 %
'   2. Column "Availability Status" = Now Available
    If Cells(i, srcColourColumnIntRed1).Value = "Now Available" _
    Or Cells(i, srcColourColumnIntRed2).Value <= 60 _
    Then Cells(i, 1).Interior.Color = RGB(255, 0, 0)
Next i

'========================
'make cell YELLOW
'========================
For i = 2 To rowCount
'based on following condition
'   1. Column "Coming Available Category" = Available in the next 2 weeks
    If Cells(i, srcColourColumnIntYellow).Value = "Resource First Available Day 1-7 Days" _
    Or Cells(i, srcColourColumnIntYellow).Value = "Resource First Available Day 8-14 Days" _
    Then Cells(i, 1).Interior.Color = RGB(255, 255, 0)
Next i

'========================
'make cell BLUE
'========================
For i = 2 To rowCount
'based on following conditions
'   1. Column "Current Calendar" unequal to "Booked To A Project"
'   2. Column "Current Calendar" unequal to empty
'   3. Column "Current Calendar End Date" < to 42 days AND > 12 days

olderDate = Cells(i, Range("Table1[Current Calendar End Date]").Column)
currentDate = Date
dateDifference = DateDiff("d", currentDate, olderDate, vbMonday)

    If (Cells(i, srcColourColumnIntBlue1).Value <> "Booked To A Project" _
        And Cells(i, srcColourColumnIntBlue1).Value <> "") _
        Or (dateDifference <= 42 And dateDifference > 14) _
        Then Cells(i, 1).Interior.Color = RGB(0, 0, 255)
Next i

'========================
'make cell GREEN
'========================
For i = 2 To rowCount
'based on following condition
'   1. Name does not exist in previous weeks' sheet, identified by VLOOKUP being #N/A
    If WorksheetFunction.IsNA(Cells(i, srcColourColumnIntGreen)) _
    Then Cells(i, 1).Interior.Color = RGB(0, 255, 0)
Next i
End Sub

1 个答案:

答案 0 :(得分:0)

原来,BigBen和Ron Rosenfeld的评论解决了我的问题。我只需要将dateDifference声明为Long,而Overflow错误就消失了。谢谢。