我写了一个VBA函数,它检查几件事并返回一个代码
触发条件格式。一切顺利,除了
该公式通常会触发#value
错误。它为所有人做到了这一点
含有该配方的细胞(数千)。出现错误
每当我打开另一本工作簿。有时我会这样做
打开另一本工作簿。
功能在这里:
Function jjcheck(STDTRow As Integer, cuCOL As Integer, cuMax As Integer, trmEnd As Integer, trmEMax As Integer, worksheetSRC As String, lstCTCT As Date) As Variant
'use in spreadsheet =jjcheck(B2,Variables!$G$4,Variables!$G$2,Variables!$F$2,"SRM",U2)
'=jjcheck(B2,Variables!$G$4,Variables!$F$4,Variables!$G$2,Variables!$F$2,"SRM",IF(ISBLANK(U2),TODAY(),U2))
Dim V() As String, dayMax As Integer, lookup As Date, theDiff As Integer, lstContact As String
V = Split(ActiveWorkbook.ActiveSheet.Cells(1, 2).Value, "-"): dayMax = V(1): theDiff = 256
lookup = lstCTCT
theDiff = DateDiff("d", lookup, Date): lstContact = ""
If theDiff > dayMax Then lstContact = "Alert"
Dim STDcu As Integer, STtrmEnd As Date, daysTOtrmend As Integer
STDcu = ActiveWorkbook.Worksheets(worksheetSRC).Cells(STDTRow, cuCOL).Value
STtrmEnd = ActiveWorkbook.Worksheets(worksheetSRC).Cells(STDTRow, trmEnd).Value
daysTOtrmend = DateDiff("d", Date, STtrmEnd)
If STDcu < cuMax And daysTOtrmend < trmEMax Then
jjcheck = "CHECK" & lstContact
ElseIf daysTOtrmend < trmEMax / 2 Then
jjcheck = "ETerm" & lstContact
Else
jjcheck = "" & lstContact
End If
End Function
怀疑错误可能是由于单元格U2
为空,I
我将lstCTCT
的内容更改为IF(ISBLANK(U2),TODAY(),U2)
这似乎没有帮助。The image shows what happens in the worksheet
感谢您提供的任何见解。
答案 0 :(得分:0)
如果这有什么不同,请告诉我?主要变化来自
ActiveWorkbook
到ThisWorkbook
。 (其他一些只是为了整理)
Function jjcheck(STDTRow As Integer, cuCOL As Integer, cuMax As Integer, trmEnd As Integer, trmEMax As Integer, worksheetSRC As String, lstCTCT As Date) as Variant
'use in spreadsheet =jjcheck(B2,Variables!$G$4,Variables!$G$2,Variables!$F$2,"SRM",U2)
'=jjcheck(B2,Variables!$G$4,Variables!$F$4,Variables!$G$2,Variables!$F$2,"SRM",IF(ISBLANK(U2),TODAY(),U2))
Dim V() As String, lstContact As String
Dim dayMax As Integer, theDiff As Integer, STDcu As Integer, daysTOtrmend As Integer
Dim lookup As Date, STtrmEnd As Date
STDcu = ThisWorkbook.Worksheets(worksheetSRC).Cells(STDTRow, cuCOL).Value
STtrmEnd = ThisWorkbook.Worksheets(worksheetSRC).Cells(STDTRow, trmEnd).Value
daysTOtrmend = DateDiff("d", Date, STtrmEnd)
V = Split(ThisWorkbook.ActiveSheet.Cells(1, 2).Value, "-"): dayMax = V(1): theDiff = 256
lookup = lstCTCT
theDiff = DateDiff("d", lookup, Date): lstContact = vbNulltring
If theDiff > dayMax Then lstContact = "Alert"
If STDcu < cuMax And daysTOtrmend < trmEMax Then
jjcheck = "CHECK" & lstContact
ElseIf daysTOtrmend < trmEMax / 2 Then
jjcheck = "ETerm" & lstContact
Else
jjcheck = vbNullString & lstContact
End If
End Function