Мои коды работают, но мне интересно, где я могу улучшить код, что вы можете предложить? - PullRequest
0 голосов
/ 30 апреля 2019

Мой код работает довольно быстро.Я решил использовать FSO, так как я буду открывать и читать несколько больших файлов во время выполнения этого кода.Мой код уже работает довольно быстро, но мне интересно, что я мог бы сделать, чтобы улучшить его.

Я уже выключил обновление экрана, кроме включения ручных вычислений (не входит в сферу этого проекта), чтоя мог сделать?

Row = 2

On Error GoTo ErrHandler

'Paths
serverPath = "\\kingnet\public\reports\"

'Files
lcaseReport = "Slbs_a01.txt"
dcaseReport = "Dlbs_a01.txt"

Application.ScreenUpdating = False

With Sheet2

    Do While .Cells(Row, 3) <> ""

        If (Cells(Row, 7)) = Date Then
            filePath = serverPath
        ElseIf (Cells(Row, 7)) < Date Then
            filePath = serverPath & "archive\" & Format(.Cells(Row, 7), "mmddyyyy") & "\"
        ElseIf (Cells(Row, 7)) = "" Then
            GoTo Skip
        End If

        If .Cells(Row, 8) = "" Then
            Set fsoStream = FSO.OpenTextFile(filePath & lcaseReport, ForReading)

            Do While fsoStream.AtEndOfStream <> True
                strLine = fsoStream.ReadLine
                carton = Mid(strLine, 10, 16)

                'lcase First Label
                If carton = .Cells(Row, 3).Value = True Then
                    .Cells(Row, 8).Value = Mid(strLine, 31, 5)
                    .Cells(Row, 11).Value = Mid(strLine, 41, 5)
                    .Cells(Row, 13).Value = "lcase"
                End If

                'lcase Last Label
                If carton = .Cells(Row, 4).Value = True Then
                    .Cells(Row, 8).Value = Mid(strLine, 31, 5)
                    .Cells(Row, 12).Value = Mid(strLine, 41, 5)
                    .Cells(Row, 14).Value = .Cells(Row, 12).Value - .Cells(Row, 11).Value
                End If
            Loop

            fsoStream.Close
            Set FSO = Nothing
        End If

Skip:
        Row = Row + 1
    Loop

End With

'dcase
Row = 2

With Sheet2

    Do While .Cells(Row, 3) <> ""

        If (Cells(Row, 7)) = Date Then

            filePath = serverPath

        ElseIf (Cells(Row, 7)) < Date Then

            filePath = serverPath & "archive\" & Format(.Cells(Row, 7), "mmddyyyy") & "\"

        Else
            GoTo Skip2
        End If

        If .Cells(Row, 13) = "" Then
            Set fsoStream = FSO.OpenTextFile(filePath & dcaseReport, ForReading)
            Do While fsoStream.AtEndOfStream <> True
                strLine = fsoStream.ReadLine
                carton = Mid(strLine, 10, 16)

                'dcase First Label
                If carton = .Cells(Row, 3).Value = True Then
                    .Cells(Row, 8).Value = Mid(strLine, 31, 5)
                    .Cells(Row, 11).Value = Mid(strLine, 41, 5)
                    .Cells(Row, 13).Value = "dcase"
                End If

                'dcase Last Label
                If carton = .Cells(Row, 3).Value = True Then
                    .Cells(Row, 8).Value = Mid(strLine, 31, 5)
                    .Cells(Row, 12).Value = Mid(strLine, 41, 5)
                    .Cells(Row, 14).Value = .Cells(Row, 12).Value - .Cells(Row, 11).Value
                End If
            Loop

            fsoStream.Close
            Set FSO = Nothing
        End If

Skip2:
        Row = Row + 1
    Loop

End With

Application.ScreenUpdating = True

Exit Sub

ErrHandler:
Select Case Err.Number
    Case 76
    MsgBox "Archive folder for date " & (Cells(Row, 7)) & " on row number " & Row & " missing. Contact Server Ops. To skip this line click ignore.", vbAbortRetryIgnore + vbDefaultButton3

    Resume Skip

    Case 53

    MsgBox "File missing from " & filePath & ". Files may be archived, run again after midnight or contact Server Ops.", vbAbortRetryIgnore + vbDefaultButton3

    Resume Skip
End Select
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...