1

当我有一个包含自定义函数的 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, 0).Value, "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
                    'find the sharecount in monthly file
                    sharec = regfind.Offset(j, 0).Value

                    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, 2) 'mon=1, 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
4

0 回答 0