Блог

Главная - Вопросы по программированию - Скрипт VBA для импорта текстовых данных в первый пустой столбец диапазона

Скрипт VBA для импорта текстовых данных в первый пустой столбец диапазона

#vba #text #import

Вопрос:

Я создал сценарий VBA для импорта текстового файла в определенном диапазоне столбцов электронной таблицы (AK5:AR44), и я хотел бы сделать его более эффективным со следующими изменениями, для которых мне может понадобиться ваша помощь:

  1. Используйте в качестве пункта назначения:=Диапазон первого пустого столбца в заданном диапазоне
  2. Создайте своего рода цикл, после импорта каждого файла пользователь должен иметь возможность импортировать другой файл в первый новый пустой столбец

Ниже кода, который я создал до сих пор

    Sub Import_samples_data_rep()
Dim Sample1_repfile As String
    MsgBox "Select text file", vbOKOnly
    Sample1_repfile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
Dim Stuff
'assign variables
 On Error GoTo ErrHandler:
ErrHandler: If Err.Number = 1004 Then
ErrMsg = Error(Err.Number)
Exit Sub
End If
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" amp; Sample1_repfile, Destination:=Range("$AK$5"))
        .Name = "*.txt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 14
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 9, 1, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Dim answer As Integer
answer = MsgBox("Import another file?", vbQuestion   vbYesNo   vbDefaultButton2, "Import again")
If answer = vbYes Then
Sample2_repfile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" amp; Sample2_repfile, Destination:=Range("$AL$5"))
        .Name = "*.txt"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 14
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 9, 1, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Else
MsgBox "File import ended", vbOKOnly
End If
End Sub
Метки: