Отладка через шаги VBA в другую функцию? - PullRequest
1 голос
/ 04 ноября 2019

Когда у меня есть книга с кодом VBA, содержащая пользовательскую функцию, я заметил, что отладчик случайным образом входит в середину кода функции. Это происходит, когда у меня есть UDF в файлах .xlam и пользовательские функции в локальных макросах. Это не было бы проблемой, если бы он только циклически проходил через функцию, но, кажется, он зацикливался бесконечно, что делает отладку невозможной. Кто-нибудь еще имеет эту проблему, или знает, как ее исправить?

т.е. вот тот, который дал мне проблему сегодня:

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
                        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, 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...