Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Вывести список названия файлов и максимума в каждом из них - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вывести список названия файлов и максимума в каждом из них (Макросы/Sub)
Вывести список названия файлов и максимума в каждом из них
ant6729 Дата: Воскресенье, 09.12.2018, 16:51 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Всем привет, иногда кажется, что все вроде, неплохо понял) По крайней мере, знаешь, куда подсмотреть
И как только ты начинаешь так считать, какая-то задача ставит тебя в действительный ступор

У меня есть четыре файла txt
В каждом из них сразу после времени, после запятой значения.
Нужно выяснить, какое значение максимальное среди этих всех файлов
В идеале вывести название этого файла c этим максимальным значением на лист 1
Может быть, что будет несколько файлов с максимальным значением, тогда нужно вывести несколько
Тогда вывести на лист 1 все эти файлы, например списком...

Скажу сразу, так как от VBA ухожу. Хочу еще что-то с пайтон. Поэтому это решение у меня есть на пайтон.
Можете посмотреть, что оно дает



Пробовал объединять файлы в один(благо, есть коды для объединения txt файлов в один на страницу через диалог)
Дальше делал текст по столбцам (ставил пробел и запятую) и дальше можно было искать максимум (имя файла рядом в строку не выводил уже...)

Файлов, ясно, что может быть не 4... а 1000, например...

Поэтому вариант с загоном всех данных на лист, а потом обработка через текст по столбцам будет не очень..

Как можно обращаться напрямую и читать?
Теоретически - открыл файл, внес по маске регулярных выражений в словарь, фильтранулся в нем, закрыл файл.
Практически... пока не знаю..
Честно сказать, этим на ходу изобретенным тестовым заданием, меня поставили в стопор, так как пришлось думать на ходу. А первый раз он... непонятный.
Поэтому просто решил через текст по столбцам с объединением этих четырех файлов через макрос
Если у кого-то более продвинутые решения?
Приложил пример файла.
Сам файл на 20000 в оригинале, файлов может быть намного больше
К сообщению приложен файл: OBC.TskMdt2.pro.txt (1.1 Kb)


Сообщение отредактировал ant6729 - Воскресенье, 09.12.2018, 16:59
 
Ответить
СообщениеВсем привет, иногда кажется, что все вроде, неплохо понял) По крайней мере, знаешь, куда подсмотреть
И как только ты начинаешь так считать, какая-то задача ставит тебя в действительный ступор

У меня есть четыре файла txt
В каждом из них сразу после времени, после запятой значения.
Нужно выяснить, какое значение максимальное среди этих всех файлов
В идеале вывести название этого файла c этим максимальным значением на лист 1
Может быть, что будет несколько файлов с максимальным значением, тогда нужно вывести несколько
Тогда вывести на лист 1 все эти файлы, например списком...

Скажу сразу, так как от VBA ухожу. Хочу еще что-то с пайтон. Поэтому это решение у меня есть на пайтон.
Можете посмотреть, что оно дает



Пробовал объединять файлы в один(благо, есть коды для объединения txt файлов в один на страницу через диалог)
Дальше делал текст по столбцам (ставил пробел и запятую) и дальше можно было искать максимум (имя файла рядом в строку не выводил уже...)

Файлов, ясно, что может быть не 4... а 1000, например...

Поэтому вариант с загоном всех данных на лист, а потом обработка через текст по столбцам будет не очень..

Как можно обращаться напрямую и читать?
Теоретически - открыл файл, внес по маске регулярных выражений в словарь, фильтранулся в нем, закрыл файл.
Практически... пока не знаю..
Честно сказать, этим на ходу изобретенным тестовым заданием, меня поставили в стопор, так как пришлось думать на ходу. А первый раз он... непонятный.
Поэтому просто решил через текст по столбцам с объединением этих четырех файлов через макрос
Если у кого-то более продвинутые решения?
Приложил пример файла.
Сам файл на 20000 в оригинале, файлов может быть намного больше

Автор - ant6729
Дата добавления - 09.12.2018 в 16:51
Hugo Дата: Воскресенье, 09.12.2018, 17:23 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3250
Репутация: 707 ±
Замечаний: 0% ±

2019
Чтение текстовых файлов - это думаю в любом учебнике на первом десятке страниц.
Но могу подсказать - вот например получаем массив строк:
[vba]
Код
A = Split(CreateObject("Scripting.FileSystemObject").Getfile(TxtPath$).OpenasTextStream(1).ReadAll, vbNewLine)
[/vba]
Читаете построчно любым способом (или цикл по массиву строк), анализируете каждую строку (например Split 2 раза на 2 части), определяете максимум, а имена файлов можно собирать например в словарь максимумов с коллекцией имён файлов.


excel@nxt.ru
webmoney: E265281470651 Z422237915069


Сообщение отредактировал Hugo - Воскресенье, 09.12.2018, 17:26
 
Ответить
СообщениеЧтение текстовых файлов - это думаю в любом учебнике на первом десятке страниц.
Но могу подсказать - вот например получаем массив строк:
[vba]
Код
A = Split(CreateObject("Scripting.FileSystemObject").Getfile(TxtPath$).OpenasTextStream(1).ReadAll, vbNewLine)
[/vba]
Читаете построчно любым способом (или цикл по массиву строк), анализируете каждую строку (например Split 2 раза на 2 части), определяете максимум, а имена файлов можно собирать например в словарь максимумов с коллекцией имён файлов.

Автор - Hugo
Дата добавления - 09.12.2018 в 17:23
sboy Дата: Понедельник, 10.12.2018, 09:33 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
Несложная задачка для PQ. Но время обработки 1000 файлов не знаю, надо тестить.


Добавлено: протестировал 1024 копии файла. Обновление таблицы заняло около 1 секунды
К сообщению приложен файл: PQ_max_txt.xlsx (24.7 Kb)


Яндекс: 410016850021169

Сообщение отредактировал sboy - Понедельник, 10.12.2018, 11:42
 
Ответить
СообщениеДобрый день.
Несложная задачка для PQ. Но время обработки 1000 файлов не знаю, надо тестить.


Добавлено: протестировал 1024 копии файла. Обновление таблицы заняло около 1 секунды

Автор - sboy
Дата добавления - 10.12.2018 в 09:33
ant6729 Дата: Пятница, 14.12.2018, 03:13 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Честно сказать, сейчас только руки дошли, но ничего из двух примеров выше не понял
В своем примере сейчас не понимаю, как вывести в debug только первые цифры после запятой

У меня выводит сначала до запятой как одну строку, а потом ниже после запятой, как вторую
Прошу запустить код, чтобы понять, о чем я.

[vba]
Код
Sub SendReportFiles()

    Dim fsoFile As file, fsoFolder As Folder
    Dim ReportFile
    Dim dict As Scripting.Dictionary
    Dim fso As New FileSystemObject
    Dim Spath, StrFile
    Spath = Application.ThisWorkbook.Path & "\"
    Set fsoFolder = fso.GetFolder(Spath)
    
    Set dict = New Scripting.Dictionary
    
    For Each fsoFile In fsoFolder.Files

        If fsoFile Like "*.txt" Then
        'dict.Add fsoFile.Name, 0
       
        Open fsoFile For Input As #1
        Dim s As String
        While Not EOF(1)
            Input #1, s
            Debug.Print Left(s, 20) '& " " & fsoFile.Name
        Wend
        Close #1
        
        End If
        
    Next fsoFile
    
End Sub
[/vba]

Помогите, пожалуйста, выводить без лишних строк, где время


Сообщение отредактировал ant6729 - Пятница, 14.12.2018, 04:24
 
Ответить
СообщениеЧестно сказать, сейчас только руки дошли, но ничего из двух примеров выше не понял
В своем примере сейчас не понимаю, как вывести в debug только первые цифры после запятой

У меня выводит сначала до запятой как одну строку, а потом ниже после запятой, как вторую
Прошу запустить код, чтобы понять, о чем я.

[vba]
Код
Sub SendReportFiles()

    Dim fsoFile As file, fsoFolder As Folder
    Dim ReportFile
    Dim dict As Scripting.Dictionary
    Dim fso As New FileSystemObject
    Dim Spath, StrFile
    Spath = Application.ThisWorkbook.Path & "\"
    Set fsoFolder = fso.GetFolder(Spath)
    
    Set dict = New Scripting.Dictionary
    
    For Each fsoFile In fsoFolder.Files

        If fsoFile Like "*.txt" Then
        'dict.Add fsoFile.Name, 0
       
        Open fsoFile For Input As #1
        Dim s As String
        While Not EOF(1)
            Input #1, s
            Debug.Print Left(s, 20) '& " " & fsoFile.Name
        Wend
        Close #1
        
        End If
        
    Next fsoFile
    
End Sub
[/vba]

Помогите, пожалуйста, выводить без лишних строк, где время

Автор - ant6729
Дата добавления - 14.12.2018 в 03:13
_Boroda_ Дата: Пятница, 14.12.2018, 09:22 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
У меня в новом файле Ваш макрос ругается. Библиотеки какие подключены? Лень вручную лазать
Приложите свой файл с макросом и вручную желаемый результат


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеУ меня в новом файле Ваш макрос ругается. Библиотеки какие подключены? Лень вручную лазать
Приложите свой файл с макросом и вручную желаемый результат

Автор - _Boroda_
Дата добавления - 14.12.2018 в 09:22
ant6729 Дата: Суббота, 15.12.2018, 02:36 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Библиотека Microsoft Scripting Runtime
Попробовал сам допилить...

Прикрепил архивы и файл ниже

3 Еще хотел вывести в MsgBox не только максимальное, но и рядом название файла - не допер, как...Потому что вроде, application.max и рядом как fsoFile.Name или .Items, но как соответствующий... что-то не понял...

5 Если можно, оцените структуру кода, может, можно было иначе накидать, предполагаю, что можно было через массивы, но не силен.
К сообщению приложен файл: Script.xlsb (18.6 Kb)


Сообщение отредактировал ant6729 - Суббота, 15.12.2018, 03:58
 
Ответить
СообщениеБиблиотека Microsoft Scripting Runtime
Попробовал сам допилить...

Прикрепил архивы и файл ниже

3 Еще хотел вывести в MsgBox не только максимальное, но и рядом название файла - не допер, как...Потому что вроде, application.max и рядом как fsoFile.Name или .Items, но как соответствующий... что-то не понял...

5 Если можно, оцените структуру кода, может, можно было иначе накидать, предполагаю, что можно было через массивы, но не силен.

Автор - ant6729
Дата добавления - 15.12.2018 в 02:36
ant6729 Дата: Суббота, 15.12.2018, 02:36 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
1 Оригиналы не присоединю, каждый txt на 5 000 кб и таких много

Можно ли не тратить ресурсы на открытие, в принципе?

Можно ли обойтись без on error reusme?
Мне кажется, я просто неверно что-то написал... это выглядит, как реальный костыль...


Сообщение отредактировал ant6729 - Суббота, 15.12.2018, 03:39
 
Ответить
Сообщение1 Оригиналы не присоединю, каждый txt на 5 000 кб и таких много

Можно ли не тратить ресурсы на открытие, в принципе?

Можно ли обойтись без on error reusme?
Мне кажется, я просто неверно что-то написал... это выглядит, как реальный костыль...

Автор - ant6729
Дата добавления - 15.12.2018 в 02:36
ant6729 Дата: Суббота, 15.12.2018, 02:37 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
Выполнение кода на 15 КБ (4 файла txt) заняло минуту...
Можно ли как-то оптимизироваться?
Потому что, например (ну, я так думаю, мало ли) файлов будет 1000...

На Python, кстати, 2 секунды...


Сообщение отредактировал ant6729 - Суббота, 15.12.2018, 03:55
 
Ответить
СообщениеВыполнение кода на 15 КБ (4 файла txt) заняло минуту...
Можно ли как-то оптимизироваться?
Потому что, например (ну, я так думаю, мало ли) файлов будет 1000...

На Python, кстати, 2 секунды...

Автор - ant6729
Дата добавления - 15.12.2018 в 02:37
ant6729 Дата: Суббота, 15.12.2018, 02:40 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
2
К сообщению приложен файл: 3817256.rar (3.2 Kb)
 
Ответить
Сообщение2

Автор - ant6729
Дата добавления - 15.12.2018 в 02:40
RAN Дата: Суббота, 15.12.2018, 10:57 | Сообщение № 10
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Много читал, ничего не понял.
Архив не открывается, но 4 копии файла из №1 обрабатывает за 0,0078 сек (с выгрузкой на лист 0,0117).
[vba]
Код
Sub мяв()
    Dim fName$
    Dim i&, lMax&
    Dim spl, s
    Dim fso As New FileSystemObject
    Dim col As New Collection, x
    Dim t!, t1!
    t = Timer: t1 = t
    On Error Resume Next
    fName = Dir(ThisWorkbook.Path & "\*.txt")
    Do While fName$ <> ""
        s = fso.OpenTextFile(fName).ReadAll
        spl = Split(s, vbCrLf)
        For i = 0 To UBound(spl)
            If lMax < Val(Mid(spl(i), 10, 3)) Then
                lMax = Val(Mid(spl(i), 10, 3))
                Set col = New Collection
                col.Add fName, fName
            ElseIf lMax = Val(Mid(spl(i), 10, 3)) Then
                col.Add fName, fName
            End If
        Next
        fName = Dir
        DoEvents
    Loop
    Debug.Print Format(Timer - t, "0.0000")
    [c1] = lMax
    i = 0
    For Each x In col
        i = i + 1
        Range("D" & i) = x
    Next
    Debug.Print Format(Timer - t1, "0.0000")
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Суббота, 15.12.2018, 10:57
 
Ответить
СообщениеМного читал, ничего не понял.
Архив не открывается, но 4 копии файла из №1 обрабатывает за 0,0078 сек (с выгрузкой на лист 0,0117).
[vba]
Код
Sub мяв()
    Dim fName$
    Dim i&, lMax&
    Dim spl, s
    Dim fso As New FileSystemObject
    Dim col As New Collection, x
    Dim t!, t1!
    t = Timer: t1 = t
    On Error Resume Next
    fName = Dir(ThisWorkbook.Path & "\*.txt")
    Do While fName$ <> ""
        s = fso.OpenTextFile(fName).ReadAll
        spl = Split(s, vbCrLf)
        For i = 0 To UBound(spl)
            If lMax < Val(Mid(spl(i), 10, 3)) Then
                lMax = Val(Mid(spl(i), 10, 3))
                Set col = New Collection
                col.Add fName, fName
            ElseIf lMax = Val(Mid(spl(i), 10, 3)) Then
                col.Add fName, fName
            End If
        Next
        fName = Dir
        DoEvents
    Loop
    Debug.Print Format(Timer - t, "0.0000")
    [c1] = lMax
    i = 0
    For Each x In col
        i = i + 1
        Range("D" & i) = x
    Next
    Debug.Print Format(Timer - t1, "0.0000")
End Sub
[/vba]

Автор - RAN
Дата добавления - 15.12.2018 в 10:57
ant6729 Дата: Суббота, 15.12.2018, 13:54 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 533
Репутация: 2 ±
Замечаний: 40% ±

Excel 2010
У меня Ваш код не смог сработать
Я посмотрел по locals - наполняются только переменные с fName

Коллекция не заполняется.
Но, в любом случае, спасибо

Мне интересно уже, неужели vba проиграет питону...
Пример одного файла в урезанном варианте приложил
К сообщению приложен файл: 6072453.txt (1.6 Kb)


Сообщение отредактировал ant6729 - Суббота, 15.12.2018, 14:24
 
Ответить
СообщениеУ меня Ваш код не смог сработать
Я посмотрел по locals - наполняются только переменные с fName

Коллекция не заполняется.
Но, в любом случае, спасибо

Мне интересно уже, неужели vba проиграет питону...
Пример одного файла в урезанном варианте приложил

Автор - ant6729
Дата добавления - 15.12.2018 в 13:54
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вывести список названия файлов и максимума в каждом из них (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!