Макрос и построчный отладчик обрабатывают данные по-разному - PullRequest
0 голосов
/ 27 сентября 2018

У меня проблемы с таргетингом на конкретное имя файла.В качестве примера: «FE2620F_18220_D02_102_AA03.csv» Макрос просит пользователя выбрать каталог, содержащий файлы .csv.

Файлы обрабатываются по порядку (по крайней мере, это цель).Когда я запускаю макрос с помощью кнопки формы или из панели макросов или из редактора с помощью кнопки воспроизведения, этот конкретный файл пропускается.

Файлы с такими именами, как "FE2620F_18220_D02_102_E03.csv" или "REF_STD_092618_6.csv", работают нормально.Во время отладки с помощью команды Step Into все файлы работают нормально.

На самом деле, если я просто перешагну точку, в которой файл обычно будет удален, то нажму кнопку «Продолжить», все работает нормально.

Sub reflectivity()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    'This code prompts a user for a directory that contains files of type extType,
    'then extracts average values that are defined by r1,r2,r3 and writes them,
    'along with the file name to the next open cell in the workbook aBook including
    'a blank line after each directory worth of files
    'then it closes the books and saves the changes

    Dim r1 As Range, r2 As Range, r3 As Range
    Dim Tr1 As Range, Tr2 As Range, Tr3 As Range, Tr4 As Range
    Dim strTr1 As String, strTr2 As String, strTr3 As String, strTitle As String
    Dim meas1 As Double, meas2 As Double, meas3 As Double
    Dim fDialog As FileDialog
    Dim pathName As String, extType As String, operFile As String, targetPath As String, targetpath2 As String, fileType As String
    Dim prefix As String, file As String
    Dim count As Integer, nextEntry As Integer
    Dim aBook As Workbook, bBook As Workbook
    Dim aSheet As Worksheet, bSheet As Worksheet, wsTest As Worksheet

    Set aBook = ThisWorkbook
    Set wsTest = Nothing

    On Error Resume Next
    Set wsTest = ActiveWorkbook.Worksheets("Calc")
    On Error GoTo 0

    If wsTest Is Nothing Then
        Worksheets.Add.NAME = "Calc"
    End If

    Set aSheet = Worksheets("Calc")
    'set bSheet to the workbook where you want to add the summarized data
    Set bBook = ThisWorkbook
    Set bSheet = bBook.Worksheets("Sheet1")

    'choose which type of file has your data to extract
    fileType = "*.csv"
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)

    With fDialog
        .Title = "Select Directory"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        pathName = .SelectedItems(1) & "\"
    End With

    extType = fileType
    operFile = Dir(pathName & extType)
    prefix = "TEXT;"

    'open csv into sheet(1) and csv_get it
    Set r1 = Worksheets("Calc").Range("$B$43:$B$89")
    Set r2 = Worksheets("Calc").Range("$B$152:$B$199")
    Set r3 = Worksheets("Calc").Range("$B$311:$B$352")

    Do While operFile <> ""

        file = prefix & pathName & operFile

        With aSheet.QueryTables.Add(Connection:=file, Destination:=aSheet.Range("A1"))
            .TextFileParseType = xlDelimited
            .TextFileCommaDelimiter = True
            .Refresh
        End With

        Set r1 = Worksheets("Calc").Range("$B$43:$B$89")
        Set r2 = Worksheets("Calc").Range("$B$152:$B$199")
        Set r3 = Worksheets("Calc").Range("$B$311:$B$352")
        'first cell gets written
        meas1 = csv_get(r1, aSheet)
        'second cell gets written
        meas2 = csv_get(r2, aSheet)
        'third cell gets written
        meas3 = csv_get(r3, aSheet)

        'this part finds the next line in the bSheet and writes the measurements to the new line
        nextEntry = nextLine(bBook, bSheet)
        strTr1 = "B" & nextEntry
        strTr2 = "C" & nextEntry
        strTr3 = "D" & nextEntry
        strTitle = "A" & nextEntry

        Set Tr1 = Range(strTr1)
        Set Tr2 = Range(strTr2)
        Set Tr3 = Range(strTr3)
        Set Tr4 = Range(strTitle)
        bSheet.Activate

        With bSheet
            Tr1.Value = Round(meas1, 4)
            Tr1.NumberFormat = "0.00%"
            Tr2.Value = Round(meas2, 4)
            Tr2.NumberFormat = "0.00%"
            Tr3.Value = Round(meas3, 4)
            Tr3.NumberFormat = "0.00%"
            Tr4.Value = Replace(operFile, ".csv", "", 1, 1)
        End With

        operFile = Dir()

    Loop

NextCode:
    'in case of cancel
    pathName = pathName
    If pathName = "" Then GoTo ResetSettings

ResetSettings:
    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    On Error GoTo nothingtodelete
    aSheet.QueryTables(1).SaveData = False
    aSheet.QueryTables.item(1).Delete
nothingtodelete:
    Application.DisplayAlerts = False
    Sheets("Calc").Delete
    Application.DisplayAlerts = True
End Sub

Public Function csv_get(locString As Range, wSheet As Worksheet) As Double
    wSheet.Parent.Activate
    Debug.Print locString.Address
    csv_get = Application.WorksheetFunction.Average(locString)
End Function

Public Function nextLine(wBook As Workbook, wSheet As Worksheet) As Integer
    Dim lastrow As Integer
    wBook.Activate
    With wSheet
        If Application.WorksheetFunction.CountA(wSheet.Cells) <> 0 Then
            nextLine = .Cells.Find(What:="*", _
                                   After:=.Range("A1"), _
                                   Lookat:=xlPart, _
                                   LookIn:=xlFormulas, _
                                   SearchOrder:=xlByRows, _
                                   SearchDirection:=xlPrevious, _
                                   MatchCase:=False).Row + 1
        Else
            nextLine = 1
        End If
    End With
End Function

1 Ответ

0 голосов
/ 01 октября 2018

Используя Debug.Print для параметров Tr4 и nextEntry, было ясно, что лист не записывает значения в первую строку до завершения первого цикла.Перемещение bSheet.Activate в более ранний блок и перемещение nextEntry = nextLine (bBook, bSheet) в начале кода исправили проблему.

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