当我有一个包含自定义函数的VBA代码工作簿时,我注意到调试器会随机进入函数中间代码。当我在.xlam文件中具有UDF以及在本地宏中具有自定义函数时,都会发生这种情况。如果它仅循环执行一次函数,但似乎无限循环,这将不是问题,这使得调试变得不可能。是否还有其他人有此问题,或者知道如何解决?
即这是今天给我的一个问题:
Sub checkdailytotal()
Dim i As Long,j As Long,k As Long,m As Long,n As Long
Dim filepath As String,filedate As String,filename As String,filename2 As String,filename3 As String,filetoopen As String
Dim totalunit As Double
Dim checkcount As Range
Dim wb As Workbook
Dim ws As Worksheet
Dim rg As Range,rg2 As Range,reg As Range,unitcol As Range,daterow As Range
Dim regcheck As Range,regfind As Range
Dim regnum As String,nofile As String,nofind As String,nomatch As String,totalmatch As String
Dim sharec As Double,sharediff As Double,totalshare As Double
Dim check As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
filepath = "C:\username\filepath\"
On Error Resume Next
With Sheet3
Set checkcount = .Range("B2")
.Range("A3:E50").Clear 'This is where the function got called
End With
With Sheet2
i = WorksheetFunction.Count(.Range("A:A"))
Set reg = .Range("A2",.Cells(2,.Range("A2").End(xlToRight).Column))
Set unitcol = .Range("C2",.Cells(.Range("C2").End(xlDown).Row,"C"))
For j = 1 To i 'change this to i,just testing
Set daterow = .Range("A2").Offset(j,0)
checkcount.Offset(j,-1).Value = j
filedate = Format(.Range("A2").Offset(j,0).Value,"YYYYMMDD")
filename = filepath & "XYZ File name" & filedate & ".xlsx"
filename2 = filepath & "XYZ file name" & Format(.Range("A2").Offset(j,"DD.MM.YYYY") & ".xlsx"
filename3 = filepath & filedate & ".xlsx"
If Len(Dir(filename)) = 0 Then
If Len(Dir(filename2)) = 0 Then
If Len(Dir(filename3)) = 0 Then
nofile = "No File"
Else
filetoopen = filename3
End If
Else
filetoopen = filename2
End If
Else
filetoopen = filename
End If
Set wb = Workbooks.Open(filetoopen,Password:="password")
Set ws = wb.Worksheets(1)
With ws
nofind = ""
nomatch = ""
Set regcheck = .Range("H2")
n = .Range("A2").End(xlDown).Row - 2
For k = 1 To n
regnum = regcheck.Offset(k,0).Value
Set regfind = reg.Find(regnum,LookIn:=xlValues,lookat:=xlWhole)
If regfind Is Nothing Then
nofind = nofind & " " & regfind
Else
sharec = regfind.Offset(j,0).Value 'find the sharecount in monthly file
sharediff = regcheck.Offset(k,4).Value - sharec
If Abs(Round(sharediff,1)) > 0 Then
nomatch = nomatch & " " & regfind & " " & sharediff
End If
End If
Next k
wb.Close False
totalshare = regcheck.Offset(j + 1,4).Value
totalmatch = Abs(Round(totalshare - unitcol.Value,1))
Call totalcheck(daterow.Value,nofile,totalmatch,nofind,nomatch)
nofile = ""
End With
Next j
End With
MsgBox "Check complete"
Application.Goto Sheet3.Range("A1")
End Sub
Sub totalcheck(datech As Double,nofilepath As String,totalshare As String,regfind As String,regmatch As String)
Dim check As Range
Dim m As Long
With Sheet3
Set check = .Range("B2")
m = WorksheetFunction.Count(.Range("A:A"))
Set check = check.Offset(m,0)
With check
With .Offset(0,0)
.Value = datech
.NumberFormat = "m/d/yyyy"
End With
.Offset(0,1).Value = nofilepath
.Offset(0,2).Value = totalshare
.Offset(0,3).Value = regfind
.Offset(0,4).Value = regmatch
End With
End With
End Sub
Function tplus1(todaydt As Date)
Dim holidays As Range
Dim wk As Long,wk2 As Long,wk3 As Long,i As Long,j As Long
Dim t1 As Date
wk = WorksheetFunction.Weekday(todaydt,2) 'mon=1,sun=7
If wk > 5 Then
tplus1 = "Weekend"
Exit Function
End If
If wk < 5 Then 'mon-thurs
t1 = todaydt + 1
Else 'friday
t1 = todaydt + 3
End If
With Sheet4
Set holidays = .Range("A2",.Cells(.Range("A2").End(xlDown).Row,"A"))
End With
i = WorksheetFunction.CountIf(holidays,t1)
wk2 = WorksheetFunction.Weekday(t1,sun=7
If i = 0 Then
tplus1 = t1
Exit Function
End If
If i > 0 Then
Do Until i = 0
If wk2 < 5 Then
t1 = t1 + 1
i = WorksheetFunction.CountIf(holidays,t1)
ElseIf wk2 = 5 Then
t1 = t1 + 3
i = WorksheetFunction.CountIf(holidays,t1)
ElseIf wk2 = 6 Then
t1 = t1 + 2
i = WorksheetFunction.CountIf(holidays,t1)
ElseIf wk2 = 7 Then
t1 = t1 + 1
i = WorksheetFunction.CountIf(holidays,t1)
End If
wk2 = WorksheetFunction.Weekday(t1,2)
Loop
End If
tplus1 = t1
End Function