Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Вывод данных из текстового файла
 
#1
24.01.2020 12:15:53
Добрый день, уважаемые форумчане!
Прошу подсказать - есть ли более быстрый способ вывести в диапазон листа данные из txt-файла макросом?
На данный момент есть только такой код:
Код
Sub Test2()
n = Now 'начальное время для расчета продолжительности макроса

    Open "C:\Users\Picnic\Desktop\02\01.txt" For Input As #1
    Dim s As String
    i = 1
    While Not EOF(1)
        Input #1, s
    ThisWorkbook.Sheets(1).Range("B" & i) = s
    i = i + 1
    Wend
    Close #1
    
k = Now 'конечное время для расчета продолжительности макроса
M = Format(k - n, "hh:mm:ss")
MsgBox ("Время обновления " & M)

End Sub
В оригинальном файле около 900 000 строк и этот код очень долго работает.
 
 
 
#2
24.01.2020 12:33:26
а если объявить массив с запасом?

Скрытый текст
Изменено: Nordheim - 24.01.2020 12:43:40
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#3
24.01.2020 12:36:47
Цитата
Настя_Nastya написал:
900 000 строк
быстрее будет сначала в массив это все загонять, но при таком кол-ве строк запись в один массив может вызвать переполнение памяти, особенно если ПК на 32-битах.
Возможно, быстрее будет выгружать частями(в примере по 30000 строк, но при желании константу можно увеличить):
Код
Sub Test2()
    Const UB& = 30000 'предел для массива - по столько строк выгружаем на лист разом
    Dim s As String, i&, llastr&, ff
    Dim ares()
    Dim n#
    i = 0
    llastr = 1
    n = Now 'начальное время для расчета продолжительности макроса
    ff = FreeFile 'свободный номер
    Open "C:\Users\Picnic\Desktop\02\01.txt" For Input As #ff
    
    ReDim ares(1 To UB, 1 To 1)
    While Not EOF(ff)
        Input #ff, s
        i = i + 1
        ares(i, 1) = s
        If i = UB Then
            ThisWorkbook.Sheets(1).Range("B" & llastr).Resize(i).Value = ares
            llastr = llastr + UB
            ReDim ares(1 To UB, 1 To 1)
            i = 0
        End If
    Wend
    Close #ff
    If i < UB And i > 0 Then
        ThisWorkbook.Sheets(1).Range("B" & llastr).Resize(i).Value = ares
    End If
     
    'конечное время для расчета продолжительности макроса
    MsgBox ("Время обновления " & Format(Now - n, "hh:mm:ss"))
 
End Sub
Изменено: Дмитрий(The_Prist) Щербаков - 24.01.2020 12:39:03
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#4
24.01.2020 13:01:27
Дмитрий(The_Prist) Щербаков, Nordheim, низкий поклон!!!)))
Цитата
Дмитрий(The_Prist) Щербаков написал:
особенно если ПК на 32-битах
64)
PS на 1000000 строках код Дмитрия сработал на одну секунду быстрее, но Nordheim, все равно большущее спасибо
 
 
 
#5
24.01.2020 13:17:44
Цитата
Настя_Nastya написал:
Дмитрия сработал на одну секунду быстрее
Странно, может у меня данные тестовые не те, на фото вроде менее 1 десятой секунды собрал более 900000 строк.
Как вариант связано с занимаемой массивом памятью. Могу ошибаться  ;)
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#6
24.01.2020 13:52:40
Добрый день! А стандартный импорт данных не подходит?
Владимир
 
 
 
#7
24.01.2020 13:55:01
Цитата
Nordheim написал:
на фото вроде менее 1 десятой секунды собрал
на какое фото смотреть, чтобы увидеть не 2 секунды, а менее 1? :)
P.S. Хотя сам удивлен - по идее один массив и одна выгрузка на лист должна быть быстрее, но тут есть нюанс: если ПК не особо вытягивает, то чем больше становится массив, тем "менее охотно" работает код.
Изменено: Дмитрий(The_Prist) Щербаков - 24.01.2020 13:59:13
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#8
24.01.2020 14:08:49
Цитата
Дмитрий(The_Prist) Щербаков написал:
на какое фото смотреть, чтобы увидеть не 2 секунды, а менее 1?
Не заметил что стоит формат "hh:mm:ss", обычно часы не включаю в подсчет, т.к. если макрос работает более часа, то что то нужно переделывать  :D
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#9
24.01.2020 14:13:22
Цитата
Дмитрий(The_Prist) Щербаков написал:
если ПК не особо вытягивает, то чем больше становится массив, тем "менее охотно" работает код
В этом случае нужна золотая середина, т.е. тестирование нескольких вариантов, для понимания на каком размере массива код начинает притормаживать, если это вообще принципиально, думаю что отрабатывая 1000000 строк 2-3 секунды вполне приемлимй результат, только если это все не обернуто в цикл более 100 итераций в этом случае придется ждать, или искать иные способы оптимизации.
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#10
24.01.2020 14:17:21
Цитата
Nordheim написал:
В этом случае нужна золотая середина
Спасибо за наводку, буду тестировать.
Цитата
Дмитрий(The_Prist) Щербаков написал:
ПК не особо вытягивает
возможно)))
 
 
 
#11
24.01.2020 14:59:12
Настя_Nastya, Попробуйте обернуть все в цикл и поменять значения переменной UB в диапазонах от 30000 до 130000 с шагом в 10000
типа

Код
for i=1 to 10
  UB=UB + 10000
  'ваш код с выводом итогового времени в табличку либо в Debug.Print
next

можно границу увеличить если видите что пока, чем больше массив тем быстрей отрабатывает
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#12
24.01.2020 15:22:29
Код
Sub Test2()
    Dim j&
    Dim UB& 'предел для массива - по столько строк выгружаем на лист разом
    For j = 1 To 10

            Dim s$, i&, llastr&, ares()
            Dim n#
            i = 0
            UB = UB + 90000
            llastr = 1
            n = Now 'начальное время для расчета продолжительности макроса
            ff = FreeFile 'свободный номер
            Open ThisWorkbook.Path & "\01.txt" For Input As #1
            ReDim ares(1 To UB, 1 To 1)
            While Not EOF(1)
                Input #1, s
                i = i + 1
                ares(i, 1) = s
                If i = UB Then
                    ThisWorkbook.Sheets(1).Cells(llastr, j).Resize(i).Value = ares
                    llastr = llastr + UB
                    ReDim ares(1 To UB, 1 To 1)
                    i = 0
                End If
            Wend
            Close #1
            If i < UB And i > 0 Then
                ThisWorkbook.Sheets(1).Cells(llastr, j).Resize(i).Value = ares
            End If
        Debug.Print ("Время обновления " & Format(Now - n, "hh/mm/ss") & " Размер массива :=" & UB)
    Next j
End Sub


Результат проверки
Скрытый текст

Разницы никакой на моем ноутбуке.
Изменено: Nordheim - 24.01.2020 15:24:38
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#13
24.01.2020 16:02:21
Тестовый файл (1000000 строк, 175 символов в каждой строке) обрабатывался макросом из поста #3 - 14сек,
макросом из поста #2 - 17сек
макросом из поста #12 - 14 сек
Nordheim, Дмитрий(The_Prist) Щербаков, большое спасибо, по сравнению с макросом из поста #1 - "небо и земля"!
 
 
 
#14
24.01.2020 16:12:53
Настя_Nastya, В 12 это код Дмитрия, только зацикленный с изменением размера массива в который заносятся данные. Под спойлером итоги работы на простом файле с 900000 строк
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#15
24.01.2020 16:21:32
Цитата
Настя_Nastya написал:
по сравнению с макросом из поста #1 - "небо и земля"!
Старайтесь большие объемы обрабатывать в массивах, и толко результат выкладывать на лист, так значительно быстрее будут работать макросы. Удачи.  ;)
"Все гениальное просто, а все простое гениально!!!"
 
 
 
Страницы: 1
Наверх