Передача Specifi c Столбцы из .txt в Excel - PullRequest
1 голос
/ 07 февраля 2020

Я пытаюсь перенести данные из этого файла .txt в электронную таблицу.

enter image description here

После запуска имеющегося у меня VBA все данные будут переданы, поэтому столбцы от A до столбца E будут заполнены.

enter image description here

Но мне нужны только данные в первых 3 столбцах (A- C). Я не хочу передавать какие-либо данные после столбца C. Я не могу использовать метод Range.Clear, потому что в моем реальном проекте столбцы после столбца C содержат данные, которые невозможно стереть / переписать.

Sub Fill()

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\xxxxxxx\Desktop\Input.txt", Destination:=Range("$A:$C") _
        )
        .Name = "Input"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Это мой код, есть ли способ передать только часть (первые n-ые столбцы) данных из моего текстового файла без создания дополнительного вспомогательного / справочного листа? Любая помощь будет оценена!

Ответы [ 3 ]

3 голосов
/ 07 февраля 2020

Просто измените:

.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)

на

.TextFileColumnDataTypes = Array(1, 1, 1, 9, 9, 9)

Обратите внимание: xlSkipColumn = 9

1 голос
/ 07 февраля 2020

Другой подход заключается в том, чтобы обработать текстовый файл и вернуть на лист столько столбцов, сколько вам нужно:

Sub CopyLessColumns()
 Dim strSpec As String, i As Long, colToRet As Long
 Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long
 Dim fso As Object, txtStr As Object, strText As String

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSpec = "C:\Users\xxxxxxx\Desktop\Input.txt"
  If Dir(strSpec) <> "" Then 'check if file exists
    Set txtStr = fso.OpenTextFile(strSpec)
        strText = txtStr.ReadAll
    txtStr.Close
  End If

  arrSp = Split(strText, vbCrLf)
  colToRet = 5 'Number of columns you need
  ReDim arrRez(UBound(arrSp), colToRet - 1)
  For i = 0 To UBound(arrSp)
    arrInt = Split(arrSp(i), vbTab)
    If UBound(arrInt) > colToRet - 1 Then
        For j = 0 To colToRet - 1
            arrRez(i, j) = arrInt(j)
        Next j
    End If
  Next i
  ActiveSheet.Range(Cells(1, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez
End Sub

Я также хотел бы подчеркнуть, что идея @Ron Rosenfeld блестящая, во всяком случае. Вы можете просто обновить запрос, если / когда он вам нужен ...

Чтобы легко его использовать, следующий фрагмент кода дает вам возможность построить необходимый массив до QueryTables.Add, таким образом :

  Dim arrV() As Variant, i As Long, rng As Range
  Const nrCol As Long = 20 'Number of columns to be returned
  Set rng = Range("$A:$AF")

  ReDim arrV(1 To rng.Columns.count)
  For i = 1 To rng.Columns.count
     If i > nrCol Then
        arrV(i) = 9
     Else
        arrV(i) = 1
     End If
  Next i

И затем замените строку

.TextFileColumnDataTypes = Array(1, 1, 1,...)

на

.TextFileColumnDataTypes = arrV
0 голосов
/ 07 февраля 2020

Вы можете попробовать что-то вроде этого:


With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\xxxxxxx\Desktop\Input.txt", Destination:=Range("$A:$C") _
        )
        .Name = "Input"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    Activeworksheet.Range("D:F").EntireColumn.Delete

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