Ошибка выполнения VBA «1004» при циклическом просмотре CSV-файла - PullRequest
0 голосов
/ 24 января 2019

Я пытаюсь перебрать файл .csv, открытый через FileDialog.Код выбрасывает

во время выполнения '1004' ошибка

в строке:

Set searchInColumn = ActiveSheet.Cells(i, j).Offset(, -1).EntireColumn

В этом процессе данные из заполненныхстолбцы помещаются в ячейки первого столбца, разделенные точкой с запятой.

Моя идея - запустить код в файлах .csv и .xlsx.Код сокращен.Какой бы код ни находился ниже проблемной строки, весь Sub работает на .xlsx, но застревает на .csv.Это также идет хорошо, когда я избавляюсь от всего, что связано с FileDialog, помещаю код в файл .xlsb, вставляю туда данные (из .csv) и запускаю макрос из списка alt + f8.

Я исчерпалидей для решения этой проблемы, не могли бы вы дать мне подсказку?

Sub FixCSV()

    Dim findMatch As Range, searchInColumn As Range
    Dim i As Long, j As Long, k As Long, lastRow As Long, lastColumn As Long
    Dim chosenFile As Integer
    Dim chooseFiles As Office.FileDialog

    Application.ScreenUpdating = False

    Set chooseFiles = Application.FileDialog(msoFileDialogFilePicker)

        With chooseFiles      
            .AllowMultiSelect = True
            .Title = "Please select the file."
            .InitialFileName = "c:\"
            .InitialView = msoFileDialogViewList
        End With

     chosenFile = chooseFiles.Show

    If chosenFile = -1 Then
        For k = 1 To chooseFiles.SelectedItems.Count
            Workbooks.Open chooseFiles.SelectedItems(k)          

            lastColumn = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column           

            j = 2

            Do Until j = lastColumn

                Set searchInColumn = ActiveSheet.Cells(1, j).Offset(, -1).EntireColumn
                Set findMatch = searchInColumn.Find(What:=ActiveSheet.Cells(1, j).Value)

                If ActiveSheet.Cells(1, lastColumn).Offset(0, 1).Value = "" Then                     
                        j = j + 1    
                End If
            Loop
        Next k
End Sub

1 Ответ

0 голосов
/ 27 января 2019

Проблема решена, ниже исправленного кода:

Set chooseFiles = Application.FileDialog(msoFileDialogFilePicker)

    With chooseFiles     
        .AllowMultiSelect = True
        .Title = "Please select the file."
        .InitialFileName = "c:\"
        .InitialView = msoFileDialogViewList
        .Filters.Add "All", "*.*"          
    End With

If chooseFiles.Show = -1 Then
    For k = 1 To chooseFiles.SelectedItems.Count

        'defining path+file name
        xlFileName = chooseFiles.SelectedItems(k)
        Workbooks.Open chooseFiles.SelectedItems(k)

        'to reference Worksheets explicitly in order to avoid the run-time 
         '1004' error:
        Set wrk = Workbooks.Open(xlFileName)
        Set Sh = wrk.Worksheets(1)

        'condition in case a file is .csv (splits .csv data into columns according to 
          'separators csv):       
        If InStr(1, wrk.Name, ".csv") Then              
            Sh.Range(Range("A1"), Range("A1").End(xlDown)).TextToColumns _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=True, Comma:=True, Space:=False, Other:=False               
        End If

        lastRow = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row
        lastColumn = Sh.Cells(1, Sh.Columns.Count).End(xlToLeft).Column

        i = 2           
        Do Until i = lastRow
           'do sth
        Loop
    Next k
End If

End Sub

Ответы, которые позволили мне решить проблему:

- при работе с файлами, открытыми сFileDialog: https://stackoverflow.com/a/21723463/10348607

- по .csv здесь: https://stackoverflow.com/a/8526046/10348607

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