Member 12737742 Ответов: 2

Как импортировать текстовый файл с разделителями, и текстовый классификатор " с использованием кодирования на VBA.

Как включить оба разделителя в строку элементов строки? как мне разделить данные за один раз?если я даю только vbtab данные импортируются правильно но есть двойные кавычки опущенные

Sub importfile()
Open "E:\anaken\excel n vba\project\DATA SETS_VBA.txt" For Input As #1
x = 0
Do Until EOF(1)
    Line Input #1, LineFromFile
    
    lineitems = Split(LineFromFile, vbCrLf & vbTab)
    ActiveCell.Offset(x, 0).Value = lineitems(0)
    ActiveCell.Offset(x, 1).Value = lineitems(1)
    ActiveCell.Offset(x, 2).Value = lineitems(2)
    ActiveCell.Offset(x, 3).Value = lineitems(3)
    ActiveCell.Offset(x, 4).Value = lineitems(4)
    ActiveCell.Offset(x, 5).Value = lineitems(5)
    ActiveCell.Offset(x, 6).Value = lineitems(6)
    ActiveCell.Offset(x, 7).Value = lineitems(7)
    ActiveCell.Offset(x, 8).Value = lineitems(8)
    ActiveCell.Offset(x, 9).Value = lineitems(9)
    
    x = x + 1
Loop
Close #1
End Sub


данные есть

Period	Cell Code	Region Code	Type Code	MT/TT	Trade	Panel	Sub Store Type	MBD (Region)	 Universe Number 	 PCV Universe Number 	Ideal Sample (current)	 Usable Sample 
3350607	500199	500	199	TT	manual	SIMPLE	Market Stall Large	GRA	"1,046"	"363,657,706"	29	10
3350607	500150	500	150	TT	manual	SIMPLE	Market Stall Small	GRA	"2,259"	"1,168,516,331"	28	43
3350607	610199	610	199	TT	manual	SIMPLE	Market Stall Large	North LUK	"1,326"	"323,053,612"	40	27
3350607	610150	610	150	TT	manual	SIMPLE	Market Stall Small	North LUK	"1,473"	"130,342,517"	23	29
3350607	660199	660	199	TT	manual	SIMPLE	Market Stall Large	North LUK	"2,961"	"7,213,883,348"	38	14


я хочу разграничить табуляции и двойные кавычки

2 Ответов

Рейтинг:
12

Maciej Los

Зачем заставлять двери широко распахиваться?

Воспользуйся Метод OpenText[^] для загрузки и анализа текстового файла в виде новой рабочей книги с одним листом, содержащим проанализированные данные текстового файла.

Я бы посоветовал начать запись макроса перед запуском мастер импорта текста[^], затем закончите запись. Затем вы сможете улучшить этот код в соответствии с вашими потребностями.

[Правка#1]

Workbooks.OpenText Filename:="E:\anaken\excel n vba\project\DATA SETS_VBA.txt", _
    Origin:=852, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1)), _
    TrailingMinusNumbers:=True


Другой способ-использовать QueryTables.Добавить[^] метод: 
Dim wsh As Worksheet

Set wsh = ThisWorkbook.Worksheets.Add After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

    With wsh.QueryTables.Add(Connection:= _
        "TEXT;E:\anaken\excel n vba\project\DATA SETS_VBA.txt", Destination:=Range("$A$1") _
        )
        .Name = wsh.Name
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

Member 12737742

да, с помощью макросов это можно сделать.Мои данные имеют табуляцию и двойные кавычки. разве его нельзя удалить, добавив что-то в мои коды?

Maciej Los

Можете ли вы разместить образцы данных (всего несколько строк). Затем предоставьте информацию об ожидаемом выходе.

Member 12737742

Срок ячейке код региона-код тип код МТ/ТТ торговой панели суб магазине тип ММД (регион) Вселенной количество ПВХ Вселенной количество идеальному образцу (текущая) использовать образец
3350607 500199 500 199 TT ручной простой рыночный ларек большой GRA "1,046" "363,657,706" 29 10
3350607 500150 500 150 TT ручной простой рыночный ларек Small GRA "2,259" "1,168,516,331" 28 43
3350607 610199 610 199 TT ручной простой рыночный ларек Большой Северный лук "1,326" "323,053,612" 40 27
3350607 610150 610 150 TT ручной простой рыночный ларек Малый Северный лук "1,473" "130,342,517" 23 29
3350607 660199 660 199 TT ручной простой рыночный ларек Большой Северный лук "2,961" "7,213,883,348" 38 14



и так должно быть

Срок ячейке код региона-код тип код МТ/ТТ торговой панели суб магазине тип ММД (регион) Вселенной количество ПВХ Вселенной количество идеальному образцу (текущая) использовать образец
3350607 500199 500 199 TT ручной простой рыночный ларек большой GRA 1,046 3636,57,706 29 10
3350607 500150 500 150 ТТ инструкция проста, рынок ларек небольших Гра 2,259 1,168,516,331 28 43

Maciej Los

Воспользуйся "Улучшить вопрос"виджет вместо того, чтобы публиковать такие данные в комментарии.
Публикация этих данных в комментарии теряет формат, поэтому они непригодны для использования.

Member 12737742

теперь это удобно?

Maciej Los

[РЕДАКТИРОВАТЬ]
Ответ был улучшен.

Member 12737742

окей
в функции split мы не можем использовать два разделителя?

Maciej Los

Не в VBA.

Рейтинг:
1

Patrice T

Я бы попробовал что-то вроде:

lineitems = Split(LineFromFile, vbCrLf & vbTab)
For Scan = 0 To UNound(lineitems)-1
    If Left(lineitems(scan),1)= """" And Right(lineitems(scan),1) = """" Then
        lineitems(scan) = Mid(lineitems(scan), 2, lineitems(scan).Length - 2)
    EndIf
Next


Цикл просто проверяет каждую строку на наличие встроенных кавычек и удаляет их.

[Обновление]
Остерегаться
lineitems(scan) = Replace(lineitems(scan), Chr(34), "")

Он заменяет кавычки везде! Не только вокруг значения.

Member 12737742

его показ объекта требуется во второй строке.
Vbcrlf и VB Tab не работают вместе. первая строка данных поступает в одну ячейку и в ней запускаются остальные данные

Patrice T

Какая вторая линия ?
Проверьте орфографию переменных.

Member 12737742

я добавлю цикл for в цикл do until?

Patrice T

Да сразу после
lineitems = Split(LineFromFile, vbCrLf & vbTab)
в вашем коде

Member 12737742

Sub importfile()
Открыть "E:\anaken\excel n vba\project\DATA SETS_VBA.txt" для ввода как #1

x = 0

Делать до тех пор, пока EOF(1)
Линейный Вход #1, LineFromFile
lineitems = Split(LineFromFile, vbTab)

Для i = 1 до UBound(lineitems)
Если Left (lineitems(i), 1) = """" и Right(lineitems(i), 1)="""", то
lineitems (i) = Mid(lineitems (i), 2, lineitems (i). ubound(lineitems) - 2)
Конец, Если
Следующий
И activecell.Смещение (x, 0). значение = lineitems(0)
И activecell.Смещение (x, 1). Значение = lineitems(1)
И activecell.Смещение (x, 2). Значение = lineitems(2)
И activecell.Смещение (x, 3). Значение = lineitems(3)
И activecell.Смещение (x, 4). Значение = lineitems(4)
И activecell.Смещение (x, 5). Значение = lineitems(5)
И activecell.Смещение (x, 6). значение = lineitems(6)
И activecell.Смещение (x, 7). значение = lineitems(7)
И activecell.Смещение (x, 8). значение = lineitems(8)
И activecell.Смещение (x, 9). значение = lineitems(9)
И activecell.Смещение (x, 10). Value = lineitems(10)
И activecell.Смещение (x, 11). Value = lineitems(11)
И activecell.Смещение (x, 12). Value = lineitems(12)

x = x + 1
Петля

Закрыть #1

Конец Подводной Лодки

я сделал это, но его не разделяя кавычки

Patrice T

не меняйте этого
lineitems (сканирование).Длина
это длина строки

Member 12737742

Sub importfile()
Dim scan как целое число
Открыть "E:\anaken\excel n vba\project\DATA SETS_VBA.txt" для ввода как #1
x = 0
Делать до тех пор, пока EOF(1)
Линейный Вход #1, LineFromFile
lineitems = Split(LineFromFile, vbTab)
Для scan = 1 - lineitems.Длина
Если Left (lineitems(scan), 1) = """" и Right(lineitems(scan), 1)="""", то
lineitems(scan) = Mid(lineitems(scan), 2, lineitems (scan).Длина - 2)
Конец, Если
Следующий
И activecell.Смещение (x, 0). значение = lineitems(0)
И activecell.Смещение (x, 1). Значение = lineitems(1)
И activecell.Смещение (x, 2). Значение = lineitems(2)
И activecell.Смещение (x, 3). Значение = lineitems(3)
И activecell.Смещение (x, 4). Значение = lineitems(4)
И activecell.Смещение (x, 5). Значение = lineitems(5)
И activecell.Смещение (x, 6). значение = lineitems(6)
И activecell.Смещение (x, 7). значение = lineitems(7)
И activecell.Смещение (x, 8). значение = lineitems(8)
И activecell.Смещение (x, 9). значение = lineitems(9)
И activecell.Смещение (x, 10). Value = lineitems(10)
И activecell.Смещение (x, 11). Value = lineitems(11)
И activecell.Смещение (x, 12). Value = lineitems(12)

x = x + 1
Петля

Закрыть #1

Конец Подводной Лодки
если я пишу это, то он показывает ошибку времени выполнения
объект требуется там, где начинается цикл for

Patrice T

Цикл for должен был остаться
Для scan = 0 To UBound(lineitems)-1

Member 12737742

да это работает в какой то степени но
Срок ячейке код региона-код тип код МТ/ТТ торговой панели суб магазине тип ММД (регион) Вселенной количество ПВХ Вселенной количество идеальному образцу (текущая) использовать образец
3350607 500199 500 199 TT ручной простой рыночный ларек большой GRA 1,046" 363,657,70 29 10
3350607 500150 500 150 TT ручной простой рыночный ларек Small GRA 2,259" 1,168,516, 28 43
3350607 610199 610 199 TT ручной простой рыночный ларек Большой Северный лук 1,326" 3230,53,612 40 27


под колонкой Вселенная котировки на последнем месте остаются

Member 12737742

Суб importedrfile()
Dim scan как целое число
Открыть "E:\anaken\excel n vba\project\DATA SETS_VBA.txt" для ввода как #1
x = 0
Делать до тех пор, пока EOF(1)
Линейный Вход #1, LineFromFile
lineitems = Split(LineFromFile, vbTab)
Для scan = 0 To UBound(lineitems) - 1
lineitems (scan) = Replace(lineitems (scan), Chr (34), "")
Следующий
И activecell.Смещение (x, 0). значение = lineitems(0)
И activecell.Смещение (x, 1). Значение = lineitems(1)
И activecell.Смещение (x, 2). Значение = lineitems(2)
И activecell.Смещение (x, 3). Значение = lineitems(3)
И activecell.Смещение (x, 4). Значение = lineitems(4)
И activecell.Смещение (x, 5). Значение = lineitems(5)
И activecell.Смещение (x, 6). значение = lineitems(6)
И activecell.Смещение (x, 7). значение = lineitems(7)
И activecell.Смещение (x, 8). значение = lineitems(8)
И activecell.Смещение (x, 9). значение = lineitems(9)
И activecell.Смещение (x, 10). Value = lineitems(10)
И activecell.Смещение (x, 11). Value = lineitems(11)
И activecell.Смещение (x, 12). Value = lineitems(12)

x = x + 1
Петля

Закрыть #1

Конец Подводной Лодки


я попробовал с этим, и это сработало.
спасибо