Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск  
 
 
Рейтинг 4.57/75: Рейтинг темы: голосов - 75, средняя оценка - 4.57
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146

Импорт текста из txt в excel

31.08.2020, 08:17. Показов 17426. Ответов 74

Студворк — интернет-сервис помощи студентам
Здравствуйте,
Есть файл txt_01.txt, из него необходимо скопировать содержимое
Содержимое столбцами расположено, примеру так

15rt63 174asd94 39047 494 39a049 0304
157863 174394 39047 4a94 39049 0304

1a57863 1asd394 390ds47 494 390a49 0304
15d7863 174394 39047 494 39dsd049 0304

157863 17asd394 39047 494 39049 0304
157863 174d394 3904a7 494 39049 0304

Нужен макрос, который бы скопировал всё и вставил также по столбикам с первой ячейки первой строчки в определенный лист excel файла

Листая интернет, я нашел много ссылок на такие макросы, но почему то они у меня не работают. Я их слабо понимаю, и видимо одной замены расположения txt файла недостаточно, помогите :/
Спасибо
0
Лучшие ответы (1)
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
31.08.2020, 08:17
Ответы с готовыми решениями:

Импорт txt в excel
Добрый день! Есть макрос, который импортирует txt файл в excel, подскажите, пожалуйста, как изменить код, чтобы адрес импортируемого файла...

Импорт txt в excel
Добрый день! Если кто-нибудь знает, подскажите, пожалуйста, как решить данную задачу: у меня есть файл txt с колонкой чисел, нужно...

Импорт txt в Excel
Здравствуйте! Имеется txt документ. Нужен макрос, которы будет конвертировать информацию из него в следующем виде (только начиная со второй...

74
Часто онлайн
 Аватар для КостяФедореев
987 / 637 / 280
Регистрация: 09.01.2017
Сообщений: 2,080
31.08.2020, 12:48
Студворк — интернет-сервис помощи студентам
blackfisk,
добавьте в строку
Visual Basic
1
Sheets("Ваш лист").Cells(RW, i + 1).Value = ARR(i)
0
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146
31.08.2020, 13:14  [ТС]
Цитата Сообщение от КостяФедореев Посмотреть сообщение
blackfisk,
добавьте в строку
Visual Basic
1
Sheets("Ваш лист").Cells(RW, i + 1).Value = ARR(i)
В какую строчку?
И как вернуть выбор определенного txt?
;c
0
Часто онлайн
 Аватар для КостяФедореев
987 / 637 / 280
Регистрация: 09.01.2017
Сообщений: 2,080
31.08.2020, 13:26
blackfisk, вместо 11 строки

Добавлено через 1 минуту
Цитата Сообщение от blackfisk Посмотреть сообщение
И как вернуть выбор определенного txt?
какой код в итоге то используете?
1
 Аватар для Narimanych
2752 / 1726 / 779
Регистрация: 23.03.2015
Сообщений: 5,452
31.08.2020, 13:28
blackfisk,
Цитата Сообщение от blackfisk Посмотреть сообщение
определенного txt?
Какого и где он находится?
0
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146
31.08.2020, 13:29  [ТС]
Цитата Сообщение от Narimanych Посмотреть сообщение
blackfisk,

Какого и где он находится?
txt файл лежит в этой же папке, что и excel из которого запускают макрос
0
 Аватар для Narimanych
2752 / 1726 / 779
Регистрация: 23.03.2015
Сообщений: 5,452
31.08.2020, 13:30
blackfisk,
Цитата Сообщение от blackfisk Посмотреть сообщение
txt файл лежит в этой же папке, что и excel из которого запускают макрос
Это прекрасно...

Попытаюсь еще раз:
КАК ОН НАЗЫВАЕТСЯ?
0
 Аватар для amd48
845 / 475 / 80
Регистрация: 18.05.2016
Сообщений: 1,267
Записей в блоге: 5
31.08.2020, 13:31
Цитата Сообщение от blackfisk Посмотреть сообщение
не активный лист, а лист с определенным названием, к примеру page(1)
в строке
Cells(RW, i + 1).Value
заменить на
ActiveWorkbook.Sheets("название листа").Cells(RW, i + 1).Value
или
ActiveWorkbook.Sheets(порядковый_номер_б ез_кавычек).Cells(RW, i + 1).Value
1
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146
31.08.2020, 13:35  [ТС]
Цитата Сообщение от КостяФедореев Посмотреть сообщение
blackfisk, вместо 11 строки

Добавлено через 1 минуту

какой код в итоге то используете?
Сейчас приспособил Ваш,
Сделал три макроса,
1 Ваш, создает таблицу
2 Копирует и вставляет нужное
3 закрывает ваш excel
Объединил их под одним через call

Выглядит очень самобытно, окошки за секунду раз 10 появляются и скрываются, но работает

Макрос Narimanych был бы идеальным, если б сам выбирал определенный txt файл и вставлял в определенный лист
Тогда можно было бы наделать кучу таких и объединить также под cell
Правда работает он медленно, видимо из за обработки, но это не так критично.

Думаю на обработку 10-15 txt файлов не уйдет больше 5 минут, не страшно

Добавлено через 1 минуту
Цитата Сообщение от Narimanych Посмотреть сообщение
blackfisk,

Это прекрасно...

Попытаюсь еще раз:
КАК ОН НАЗЫВАЕТСЯ?
КРИМ4.txt
0
 Аватар для Narimanych
2752 / 1726 / 779
Регистрация: 23.03.2015
Сообщений: 5,452
31.08.2020, 13:50
Цитата Сообщение от blackfisk Посмотреть сообщение
сли б сам выбирал определенный txt файл и вставлял в определенный лист
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub MMM()
Application.ScreenUpdating = False
 FL = Thosworkbook.Path & "\КРИМ.txt" ' Ваш конкретный файл
         RW = 1
 
            Open FL For Input As #1
                       Do Until EOF(1)
                                    Line Input #1, WD:
                                    ARR = Split(WD, Chr(9))
                                                  For i = 0 To UBound(ARR) - 1
                                                    Sheets("здесь должно быть имя вашего листа").Cells(RW, i + 1).Value = ARR(i)
                                                    Next
                                      RW = RW + 1
                            Loop
               Close #1
               
   Application.ScreenUpdating = True
   MsgBox "job Complete"
End Sub
0
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146
31.08.2020, 14:02  [ТС]
Цитата Сообщение от Narimanych Посмотреть сообщение
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub MMM()
Application.ScreenUpdating = False
 FL = Thosworkbook.Path & "\КРИМ.txt" ' Ваш конкретный файл
         RW = 1
 
            Open FL For Input As #1
                       Do Until EOF(1)
                                    Line Input #1, WD:
                                    ARR = Split(WD, Chr(9))
                                                  For i = 0 To UBound(ARR) - 1
                                                    Sheets("здесь должно быть имя вашего листа").Cells(RW, i + 1).Value = ARR(i)
                                                    Next
                                      RW = RW + 1
                            Loop
               Close #1
               
   Application.ScreenUpdating = True
   MsgBox "job Complete"
End Sub
Ошибка
Предыдущая версия макроса игнорирует последний столбик ()тот что с 60,9 начинается), вот исходник
Миниатюры
Импорт текста из txt в excel  
Вложения
Тип файла: txt КРИМ4.txt (4.3 Кб, 12 просмотров)
0
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146
31.08.2020, 14:04  [ТС]
Цитата Сообщение от КостяФедореев Посмотреть сообщение
blackfisk, вместо 11 строки

Добавлено через 1 минуту

какой код в итоге то используете?
Ващ макрос тоже как то странно ведет себя с этим файлом
Числа последнего столбца, выводятся не все, а только через два, к примеру
В txt:
60,9
70,1
71
89
45
67

В excel от макроса:
60,9


89
0
6998 / 2896 / 555
Регистрация: 19.10.2012
Сообщений: 8,804
31.08.2020, 14:08
Ух ты скоко понаписали!
А моё замечание не заметил никто чтоль? Ведь работает:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub macro()
    Dim a, i&, tmp
    a = Split(CreateObject("Scripting.FileSystemObject").Getfile("c:\Users\Igor\Downloads\txt2.txt").OpenasTextStream(1).readall, vbNewLine)
    For i = 0 To UBound(a)
        If Len(a(i)) Then
            tmp = Split(a(i), vbTab)
            If UBound(tmp) > 0 Then
                Cells(i + 1, 1).Resize(1, UBound(tmp) + 1) = tmp
            Else
                Cells(i + 1, 1) = tmp(0)
            End If
        End If
    Next
End Sub
1
 Аватар для Narimanych
2752 / 1726 / 779
Регистрация: 23.03.2015
Сообщений: 5,452
31.08.2020, 14:13
blackfisk,
Пришлите ваш экселовский файл плиз....
0
6998 / 2896 / 555
Регистрация: 19.10.2012
Сообщений: 8,804
31.08.2020, 14:16
Да и с КРИМ4.txt тоже всё ОК, все 59 строк на листе.
0
Часто онлайн
 Аватар для КостяФедореев
987 / 637 / 280
Регистрация: 09.01.2017
Сообщений: 2,080
31.08.2020, 14:17
Hugo121, огонь код!
1
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146
31.08.2020, 14:17  [ТС]
Цитата Сообщение от Narimanych Посмотреть сообщение
blackfisk,
Пришлите ваш экселовский файл плиз....
Вот, весь не могу, извините
Вложения
Тип файла: xlsx Книга1.xlsx (29.4 Кб, 8 просмотров)
0
6998 / 2896 / 555
Регистрация: 19.10.2012
Сообщений: 8,804
31.08.2020, 14:24
Цитата Сообщение от КостяФедореев Посмотреть сообщение
огонь код!
- ему уже лет 100 наверное...

Добавлено через 5 минут
Ещё вариант:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub macro2()
    Dim a
    a = Split(CreateObject("Scripting.FileSystemObject").Getfile("c:\Users\Igor\Downloads\КРИМ4.txt").OpenasTextStream(1).readall, vbNewLine)
    Cells(1, 1).Resize(UBound(a) + 1, 1) = Application.Transpose(a)
        Columns("A:A").TextToColumns Destination:=Range("A1"), 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 _
        ), Array(14, 1), Array(15, 1), Array(16, 1)), TrailingMinusNumbers:=True
End Sub
Можно добавить форматов столбцам,десятичные разделители под свои подогнать.
1
Нет, ну ты видел?!
8 / 8 / 0
Регистрация: 21.05.2020
Сообщений: 146
31.08.2020, 14:24  [ТС]
Цитата Сообщение от Hugo121 Посмотреть сообщение
Да и с КРИМ4.txt тоже всё ОК, все 59 строк на листе.
В конце, каждое число сохранено, как текст в ячейке, это может иметь последствия? или есть возможность это исправить?
0
 Аватар для Narimanych
2752 / 1726 / 779
Регистрация: 23.03.2015
Сообщений: 5,452
31.08.2020, 14:27
Лучший ответ Сообщение было отмечено blackfisk как решение

Решение

blackfisk,
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub MMM()
Application.ScreenUpdating = False
 FL = ThisWorkbook.Path & "\КРИМ4 .txt"
   RW = 1
            Open FL For Input As #1
                       Do Until EOF(1)
                                    Line Input #1, WD:
                                    ARR = Split(WD, Chr(9))
                                                  For i = 0 To UBound(ARR)
                                                    Cells(RW, i + 1).Value = ARR(i)
                                                    Next
                                      RW = RW + 1
                            Loop
               Close #1
               
   Application.ScreenUpdating = True
   MsgBox "job Complete"
End Sub
Добавлено через 58 секунд
Работает на вашем файле. Название текст файла скопируйте с самого файло. Название с пробелом....
0
6998 / 2896 / 555
Регистрация: 19.10.2012
Сообщений: 8,804
31.08.2020, 14:44
Цитата Сообщение от blackfisk Посмотреть сообщение
это может иметь последствия? или есть возможность это исправить?
1. мне сиё неизвестно, не моя задача.
2. можно, есть способы. Как вариант - взять мой второй код, и там повторив разбитие и записав рекордером, добавить в код форматы столбцов и свои разделители.

Добавлено через 10 минут
Вот например первый код, скорректировал чуть черех жо, но работает:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub macro()
    Dim a, i&, tm, tmp, x&
    a = Split(CreateObject("Scripting.FileSystemObject").Getfile("c:\Users\Igor\Downloads\КРИМ4.txt").OpenasTextStream(1).readall, vbNewLine)
    For i = 0 To UBound(a)
        If Len(a(i)) Then
            tm = Split(a(i), vbTab)
            ReDim tmp(0 To UBound(tm))
            If UBound(tm) > 0 Then
                For x = 0 To UBound(tm)
                    If IsNumeric(tm(x)) Then tmp(x) = --tm(x) Else tmp(x) = tm(x)
                Next
                Cells(i + 1, 1).Resize(1, UBound(tmp) + 1) = tmp
            Else
                Cells(i + 1, 1) = tmp(0)
            End If
        End If
    Next
End Sub
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
31.08.2020, 14:44

Импорт из Excel или Txt в БД Лотус
Вроде тема поднимлась так или иначе, но то что нужно не нашла. Пожалуйста, поделитесь скриптом, который может имортировать файл Excel...

Импорт текста из буфера обмена в таблицу Excel
Доброго здоровья всем! :), Нужна ваша помощь. Делаю экспорт данных из программы через буфер обмена. Текст в буфере выглядит примерно так; ...

Импорт из Excel длинного текста (более 255 символов)
Добрый день ув. форумчане! Вопрос по импорту длинного текста из Excel. Опишу с чем столкнулся, возможно кому то время сэкономит. Детектив...

Чтение текста в Юникоде из txt файла в столбец Excel 2010
В общем пытаюсь прочесть, но корректно (без кракозябр) получается только первая строка. Винда английская. Sub ReadTextFile() Dim...

Поиск определенного текста в файле .txt и вставка в определенную ячейку в Excel
Доброго времени суток. Допустим есть файл info.txt ( состоит из множества строк, например gsd = 797 .... dig = 7666 и т.д.) в корне в с...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
40
Ответ Создать тему
Новые блоги и статьи
сукцессия 29. Переход от одних деревьев на другие делать более или менее вероятностным?
anaschu 12.07.2026
Насколько смена типов микоризы — исключительное событие в двухвековой сукцессии? Оценка вероятности в пространстве параметров В текущей версии модели успешно реализован ключевой механизм. . .
сукцессия 27. Думаю, как переделывать уже написанную статью с планами на сукцессию.
anaschu 12.07.2026
Анализ соответствия модели требованиям Реализованные компоненты: Механизм закисления почвы через протонную помпу Конкуренция между типами микориз pH как триггер сукцессии C/ P соотношение. . .
Сукцессия 26. Мат модель создана.
anaschu 12.07.2026
Модель смены растительных сукцессий посредством управления грибами работает внутри небольшой ячейки почвы, восстанавливающейся после пожара, где ненадолго бывшее царство хвойных снова захватили. . .
Решил проблему с ошибкой пагинации сообщений с сервера на алгоритме обхода дерева "Эстафета хвоста".
Hrethgir 12.07.2026
Проблема была в том, что удалялась именно новая кнопка, а не старая. Ни один ИИ не обнаружил это, а сам я смог только когда с работой стало попроще и когда заставил работать будущее автономное. . .
сукцессия 25. Хронология ошибок
anaschu 12.07.2026
# От 50-тонного гриба до устойчивого леса: хроника ошибок при построении модели вековой сукцессии микоризы ## О чём эта статья В процессе построения ОДУ-модели (система дифференциальных. . .
сукцессия 24. Промежуточное общее описание модели
anaschu 12.07.2026
Хендофф: модель АМ→ЭКМ сукцессии микоризы (ризосфера, 50 лет) Содержание проекта Симуляция вековой (50 лет) экологической сукцессии в почве леса Основные участники: АМ-гриб, ЭКМ-гриб,. . .
сукцессия 23. Более физиологичная физиология, более экологичная экология, более диффурные диффуры.
anaschu 12.07.2026
Что реально нашли и починили за эти 5 часов Правило Линдемана (КПД конверсии сахара в тело, kEff) — раньше 100% полученного углерода шло прямо в биомассу гриба; теперь только kEff=0. 5 (после. . .
сукцессия 22. От артефактов к физиологии: калибровка агентной модели грибной сукцессии для воспроизведения сезонной динамики и pH-плато
anaschu 11.07.2026
Аннотация В данной работе представлена калибровка агентной модели динамики грибных сообществ (fungal-succession), направленная на устранение нефизичных артефактов (коллапс биомассы, мгновенное. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru