макрос формирования и выгрузки файла txt (оптимизация)

[v0r0nika]

Уважаемые, прошу подсказки для оптимизации имеющегося кода..
поскольку с VBA не знакома совершенно, код из рубрики "проще и тупее". Из исходного листа (план) считываются данные по столбцам и по определенным (прописанным в коде) условиям заполняется итоговый лист (выгрузка) (некоторые значения ячеек переносятся из плана, некоторые заполняются константами). Проблема в том, что при значительном объеме данных на плановом листе (а предполагается порядка тысячи строк), этот макрос будет отрабатывать уйму времени.. по такому поводу прошу помощи.
во вложении-ОНО


З.Ы.: еще один вопрос возник - при выгрузке суммы с разделителем десятичних (к примеру, 3.5 рубля (или 3,5 рубля)) и точка и запятая в txt преобразовываются в точку..возможно ли как-то указать, чтобы запятая оставалась запятой и в выгруженном файле?

[Hugo121]

Код удивительно похож на тот, что обсуждали на планете...
Я там посоветовал на массивы переходить - будет быстрее.
Практически сделать нет времени, да и желания тоже - уж больно муторно...

[v0r0nika]

Сообщение от Hugo121

Код удивительно похож на тот, что обсуждали на планете...
Я там посоветовал на массивы переходить - будет быстрее.
Практически сделать нет времени, да и желания тоже - уж больно муторно...

эм..что значит "обсуждали на планете"-не совсем понятно, если честно..может, на эту "планету" ссылка имеется хотя бы?

про массивы что-то слышала, но практическую реализацию этого не представляю..

[Hugo121]

Ссылка - http://www.planetaexcel.ru/forum.php?thread_id=32557

[alex77755]

Если необходимо сохранять в текстовик, то может имеет смысл сразу и записывать в текстовик?
Да и для обработки лучше считать в массив - значительно быстрей будет

[alex77755]

Дёрнул же меня чёрт протестировать на 10000 строк зтот Sub MergeData()
Вот результат время начала 0:42:39
время окончания 1:21:37
Задания не знаю. Поэтому не знаю требований.
Приблизительно по коду перевёл на массивы.
Заголовки не выводил. Разделитель поставил точку с запятой, а то в комментариях могут быть пробелы. Вообщем формат надо уточнить.
На счёт точек-запятых надо реальный файл.
А пока результаты такие
время начала 1:30:53
время окончания 1:30:54 для тех же 10000.

Option Explicit
Sub ВЫГРУЗКА()
Dim CON()
Dim M()
Dim ST
Dim R, C
Dim S
Dim FileName
Debug.Print Time
Sheets("Константы").Select
ST = Cells(Rows.Count, 1).End(xlUp).Row
CON = Range(Cells(1, 1), Cells(ST, 5)).Value
Sheets("План").Select
ST = Cells(Rows.Count, 1).End(xlUp).Row
M = Range(Cells(1, 1), Cells(ST, 16)).Value

FileName = ThisWorkbook.Path & "\OUT.txt"
Open FileName For Output As #1
For R = 14 To UBound(M)
S = ""
                If M(R, 13) <> 0 Then     'условие наличия суммы по Работам
                    S = CON(3, 2) & ";" & M(R, 1) & ";" & M(R, 2) & ";" & M(R, 3) & ";" & CON(4, 2)
                    S = S & ";" & CON(5, 2) & ";" & M(R, 4) & ";" & CON(6, 2) & ";" & M(R, 5) & ";" & M(R, 6)
                    S = S & ";" & M(R, 7) & ";" & M(R, 8) & ";" & M(R, 9) & ";" & M(R, 10) & ";" & CON(7, 2)
                    S = S & ";" & M(R, 11) & ";" & M(R, 12) & ";" & CON(8, 2) & ";" & M(R, 13)
                Print #1, S
                S = ""
                End If
                
                If M(R, 14) <> 0 Then         'условие наличия суммы по МТР Агента
                    S = CON(3, 3) & ";" & M(R, 1) & ";" & M(R, 2) & ";" & M(R, 3) & ";" & CON(4, 3)
                    S = S & ";" & CON(5, 3) & ";" & M(R, 4) & ";" & CON(6, 3) & ";" & M(R, 5) & ";" & M(R, 6)
                    S = S & ";" & M(R, 7) & ";" & M(R, 8) & ";" & M(R, 9) & ";" & M(R, 10) & ";" & CON(7, 3)
                    S = S & ";" & M(R, 11) & ";" & M(R, 12) & ";" & CON(8, 3) & ";" & M(R, 13)
                Print #1, S
                S = ""
                End If
                
                If M(R, 15) <> 0 Then     'условие наличия суммы по МТР Принципала
                    S = CON(3, 4) & ";" & M(R, 1) & ";" & M(R, 2) & ";" & M(R, 3) & ";" & CON(4, 4)
                    S = S & ";" & CON(5, 4) & ";" & M(R, 4) & ";" & CON(6, 4) & ";" & M(R, 5) & ";" & M(R, 6)
                    S = S & ";" & M(R, 7) & ";" & M(R, 8) & ";" & M(R, 9) & ";" & M(R, 10) & ";" & CON(7, 4)
                    S = S & ";" & M(R, 11) & ";" & M(R, 12) & ";" & CON(8, 4) & ";" & M(R, 13)
                Print #1, S
                S = ""
                End If
                
                If M(R, 16) <> 0 Then     'условие наличия суммы по МТР Принципала
                    S = CON(3, 5) & ";" & M(R, 1) & ";" & M(R, 2) & ";" & M(R, 3) & ";" & CON(4, 5)
                    S = S & ";" & CON(5, 5) & ";" & M(R, 4) & ";" & CON(6, 5) & ";" & M(R, 5) & ";" & M(R, 6)
                    S = S & ";" & M(R, 7) & ";" & M(R, 8) & ";" & M(R, 9) & ";" & M(R, 10) & ";" & CON(7, 5)
                    S = S & ";" & M(R, 11) & ";" & M(R, 12) & ";" & CON(8, 5) & ";" & M(R, 13)
                Print #1, S
                S = ""
                End If
Next R
  Debug.Print Time
Close #1
End Sub

[alex77755]

Так лучше и с заголовками

Option Explicit
Sub ВЫГРУЗКА()
Dim CON()
Dim M()
Dim ZAG()

Dim ST
Dim R, C
Dim S
Dim FileName
Debug.Print Time
Sheets("Константы").Select
ST = Cells(Rows.Count, 1).End(xlUp).Row
CON = Range(Cells(1, 1), Cells(ST, 5)).Value
Sheets("План").Select
ST = Cells(Rows.Count, 1).End(xlUp).Row
M = Range(Cells(1, 1), Cells(ST, 16)).Value
Sheets("Выгрузка").Select
ZAG = Range(Cells(1, 1), Cells(1, 20)).Value
FileName = ThisWorkbook.Path & "\OUT.txt"
Open FileName For Output As #1
For C = 1 To 20
Write #1, ZAG(1, C),
Next
Write #1,
For R = 14 To UBound(M)
                If M(R, 13) <> 0 Then     'условие наличия суммы по Работам
               Write #1, CON(3, 2), M(R, 1), M(R, 2), M(R, 3), CON(4, 2), CON(5, 2), M(R, 4), CON(6, 2) _
      ; M(R, 5), M(R, 6), M(R, 7), M(R, 8), M(R, 9), M(R, 10), CON(7, 2), M(R, 11), M(R, 12), CON(8, 2), M(R, 13)
               End If
               
                If M(R, 13) <> 0 Then        'условие наличия суммы по МТР Агента
               Write #1, CON(3, 3), M(R, 1), M(R, 2), M(R, 3), CON(4, 3), CON(5, 3), M(R, 4), CON(6, 3) _
      ; M(R, 5), M(R, 6), M(R, 7), M(R, 8), M(R, 9), M(R, 10), CON(7, 3), M(R, 11), M(R, 12), CON(8, 3), M(R, 14)
               End If
                      If M(R, 13) <> 0 Then     'условие наличия суммы по МТР Принципала
               Write #1, CON(3, 4), M(R, 1), M(R, 2), M(R, 3), CON(4, 4), CON(5, 4), M(R, 4), CON(6, 4) _
      ; M(R, 5), M(R, 6), M(R, 7), M(R, 8), M(R, 9), M(R, 10), CON(7, 4), M(R, 11), M(R, 12), CON(8, 4), M(R, 15)
               End If
         
              If M(R, 13) <> 0 Then    'условие наличия комментария по работам
               Write #1, CON(3, 5), M(R, 1), M(R, 2), M(R, 3), CON(4, 5), CON(5, 5), M(R, 4), CON(6, 5) _
      ; M(R, 5), M(R, 6), M(R, 7), M(R, 8), M(R, 9), M(R, 10), CON(7, 5), M(R, 11), M(R, 12), CON(8, 5), , M(R, 16)
               End If
Next R
  Debug.Print Time
Close #1
End Sub

[v0r0nika]

Сообщение от alex77755

Так лучше и с заголовками

ВАУ! работает действительно моментально, спасибо Вам, волшебный человек! Надеюсь, немного разберусь с реализацией и смогу в дальнейшем адаптировать под изменения формы, единственный момент-для выгрузки нужен файл txt с разделителями табуляции...при таком методе работы с итоговым файлом (open #1, close #1) возможно ли как-то дополнительно задавать формат?

А по поводу выгрузки в txt значений из поля Сумма с разделителем десятичных "." - даже в файле-примере сумму 1233,5 выгружается как 1233.5 ... наверное, придется решать вопрос с запятой уже при загрузке в стороннюю систему, заменяя . насильно..

[alex77755]

Вроде так получается. Только с заголовками проблема

                If M(R, 15) <> 0 Then     'условие наличия суммы по Работам
               Print #1, CON(3, 2), Tab, M(R, 1), Tab, M(R, 2), Tab, M(R, 3), Tab, CON(4, 2), _
               Tab, CON(5, 2), Tab, M(R, 4), Tab, CON(6, 2), Tab, M(R, 5), Tab, M(R, 6), Tab; _
               M(R, 7), Tab, M(R, 8), Tab, M(R, 9), Tab, M(R, 10), Tab, CON(7, 2), Tab, M(R, 11), _
               Tab, M(R, 12), Tab, CON(8, 2), Tab, Replace(M(R, 15), ".", ",")
               End If

[v0r0nika]

Сообщение от alex77755

Вроде так получается. Только с заголовками проблема

                If M(R, 15) <> 0 Then     'условие наличия суммы по Работам
               Print #1, CON(3, 2), Tab, M(R, 1), Tab, M(R, 2), Tab, M(R, 3), Tab, CON(4, 2), _
               Tab, CON(5, 2), Tab, M(R, 4), Tab, CON(6, 2), Tab, M(R, 5), Tab, M(R, 6), Tab; _
               M(R, 7), Tab, M(R, 8), Tab, M(R, 9), Tab, M(R, 10), Tab, CON(7, 2), Tab, M(R, 11), _
               Tab, M(R, 12), Tab, CON(8, 2), Tab, Replace(M(R, 15), ".", ",")
               End If

с таким вариантом пробовала-но в итоговом файле вместо табуляции ставит почему-то 8 пробелов. Остановилась на таком варианте (с заголовками, вроде, тоже все хорошо):

Print #1, ZAG(1, C); vbTab;
Next
'Print
Print #1,
For R = 14 To UBound(M)
If M(R, 13) <> 0 Then 'условие наличия потребности в МТР Трубы
'x = Trim M(R, 1)
Print #1, Trim(CON(3, 2)); vbTab; Trim(M(R, 1)); vbTab; Trim(M(R, 2)); vbTab; Trim(M(R, 3)); vbTab; Trim(CON(4, 2)); vbTab; Trim(CON(9, 2)); vbTab; Trim(CON(5, 2)); vbTab; Trim(M(R, 4)); vbTab; Trim(CON(6, 2)); vbTab _
; Trim(M(R, 5)); vbTab; Trim(M(R, 6)); vbTab; Trim(M(R, 7)); vbTab; Trim(M(R, 8)); vbTab; Trim(M(R, 9)); vbTab; Trim(M(R, 10)); vbTab; Trim(CON(7, 2)); vbTab; Trim(CON(2, 2)); vbTab; Trim(M(R, 12)); vbTab; Trim(CON(8, 2)); vbTab; Trim(CON(10, 2)); vbTab; Trim(M(R, 13)); vbTab
End If


TRIM пришлось добавлять везде, поскольку с vbTab местами возникали лишние пробелы..коряво, конечно, но работает!
Спасибо Вам огромное за помощь!