通过VBA调试进入其他功能?

当我有一个包含自定义函数的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
yao02fei15la 回答:通过VBA调试进入其他功能?

暂时没有好的解决方案,如果你有好的解决方案,请发邮件至:iooj@foxmail.com
本文链接:https://www.f2er.com/3164102.html

大家都在问