ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите ускорить код пожалуйста!
25 сообщений из 57, страница 1 из 3
  1  все
Помогите ускорить код пожалуйста!
    #37493666
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
Собственно проблема такая:
Все замечательно работает, но долго.. лист с 200 строками обрабатывает 30 сек, помогите ускорить макрос если это возможно.
Макрос вставляет в три таблички значения из другого файла..по критериям.

 
Вот код:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
Sub Импорт()
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\Users\Юрец\Desktop\Sheet1.xls"
    Windows("Шаблон 2.0.xlsm").Activate
    Range("AJ36").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,2,ROW(R[-35]C[-35]),4)"
    Range("AL36").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,2,ROW(R[-35]C[-37]),7)"
    Range("AJ36:AL36").Select
    Selection.AutoFill Destination:=Range("AJ36:AL127"), Type:=xlFillDefault
    Range("AJ36:AL127").Select
    Range("AM36").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*R36C43"
    Range("AM36").Select
    Selection.AutoFill Destination:=Range("AM36:AM127"), Type:=xlFillDefault
    Range("AL36:AL127").Select
    Range("AL127").Activate
    Range("AJ133").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,3,ROW(R[-132]C[-35]),4)"
    Range("AL133").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,3,ROW(R[-132]C[-37]),7)"
    Range("AJ133:AL133").Select
    Selection.AutoFill Destination:=Range("AJ133:AL188"), Type:=xlFillDefault
    Range("AJ133:AL188").Select
    Range("AM133").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*R36C43"
    Range("AM133").Select
    Selection.AutoFill Destination:=Range("AM133:AM188"), Type:=xlFillDefault
    Range("AM133:AM188").Select
    Range("AJ194").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,1,ROW(R[-193]C[-35]),4)"
    Range("AK194").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,1,ROW(R[-193]C[-36]),3)"
    Range("AJ194:AK194").Select
    Selection.AutoFill Destination:=Range("AJ194:AK286"), Type:=xlFillDefault
    Range("AJ194:AK286").Select
    Range("AJ194:AK286").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AJ36:AJ127").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AM36:AM127").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AJ133:AJ188").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AM133:AM188").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AL133:AL188").Select
    Selection.ClearContents
    Range("AL36:AL127").Select
    Range("AL127").Activate
    Selection.ClearContents
    Windows("Sheet1.xls").Activate
    ActiveWindow.Close
    Range("AJ32").Select
    ActiveCell.FormulaR1C1 = ""
    Application.ScreenUpdating = True
    Range("AJ31").Select
End Sub


Очень прошу помощи!
...
Рейтинг: 0 / 0
22.10.2011, 16:08
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37493692
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Для начала научиться оформлять код на форуме (см. правила и FAQ по оформлению сообщений)

Потом избавиться от всех Select, Selection и Active
ибо констукция
Код: plaintext
1.
Range("AJ36:AL36").Select
 Selection.AutoFill Destination:=Range("AJ36:AL127"), Type:=xlFillDefault
безболезненно меняется на
Код: plaintext
Range("AJ36:AL36").AutoFill Destination:=Range("AJ36:AL127"), Type:=xlFillDefault
и т.п.

После этого можно посмотреть, что там в коде такого тормозного.
...
Рейтинг: 0 / 0
22.10.2011, 16:46
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37493730
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
Вот: удалил Select Selections. Еще пробовал отключать расчет по формулам...и вставлялось всё моментально, но по понятным причинам везде одно и то же значение..А так время выполнения макроса все то же 30 сек....прошу помощи в оптимизации кода..

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
Sub Импорт()
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\Users\Юрец\Desktop\Sheet1.xls"
    Windows("Шаблон 2.0.xlsm").Activate
    Range("AJ36").FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,2,ROW(R[-35]C[-35]),4)"
    Range("AL36").FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,2,ROW(R[-35]C[-37]),7)"
    Range("AJ36:AL36").AutoFill Destination:=Range("AJ36:AL127"), Type:=xlFillDefault
    Range("AM36").FormulaR1C1 = "=RC[-1]*R36C43"
    Range("AM36").AutoFill Destination:=Range("AM36:AM127"), Type:=xlFillDefault
    Range("AJ133").FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,3,ROW(R[-132]C[-35]),4)"
    Range("AL133").FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,3,ROW(R[-132]C[-37]),7)"
    Range("AJ133:AL133").AutoFill Destination:=Range("AJ133:AL188"), Type:=xlFillDefault
    Range("AM133").FormulaR1C1 = "=RC[-1]*R36C43"
    Range("AM133").AutoFill Destination:=Range("AM133:AM188"), Type:=xlFillDefault
    Range("AJ194").FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,1,ROW(R[-193]C[-35]),4)"
    Range("AK194").FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,1,ROW(R[-193]C[-36]),3)"
    Range("AJ194:AK194").AutoFill Destination:=Range("AJ194:AK286"), Type:=xlFillDefault
    Range("AJ133:AL133").AutoFill Destination:=Range("AJ133:AL188"), Type:=xlFillDefault
    Range("AJ133:AL188").Select
    Range("AM133").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]*R36C43"
    Range("AM133").Select
    Selection.AutoFill Destination:=Range("AM133:AM188"), Type:=xlFillDefault
    Range("AM133:AM188").Select
    Range("AJ194").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,1,ROW(R[-193]C[-35]),4)"
    Range("AK194").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP2([Sheet1.xls]Переводчик!R1C1:R380C7,1,1,ROW(R[-193]C[-36]),3)"
    Range("AJ194:AK194").Select
    Selection.AutoFill Destination:=Range("AJ194:AK286"), Type:=xlFillDefault
    Range("AJ194:AK286").Select
    Range("AJ194:AK286").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AJ36:AJ127").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AM36:AM127").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AJ133:AJ188").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AM133:AM188").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AL133:AL188").Select
    Selection.ClearContents
    Range("AL36:AL127").Select
    Range("AL127").Activate
    Selection.ClearContents
    Windows("Sheet1.xls").Activate
    ActiveWindow.Close
    Range("AJ32").Select
    ActiveCell.FormulaR1C1 = ""
    Application.ScreenUpdating = True
    Range("AJ31").Select
End Sub
...
Рейтинг: 0 / 0
22.10.2011, 18:04
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37493748
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
Geo28от: удалил Select Selectionsкак же удалил, когда еще 17 раз встречается...

Нет никакого смысла делать Select, а потом работать с Selection или с ActiveCell, можно все методы применять сразу к Range.
То же касается закрытия активного окна....

Ну а по производительности... хорошо бы файл иметь, чтобы на нем смотреть
...
Рейтинг: 0 / 0
22.10.2011, 18:35
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37494059
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
ИМХО, ускорить "вставление" здесь сможет отключение/включение автопересчета (ибо ВПР() летуча...)
Ну и, естественно, изучение объекной модели.
...
Рейтинг: 0 / 0
23.10.2011, 05:52
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37494061
Фотография Serge 007
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Serge 007
Участник
AndreTM...ибо ВПР() летуча...
ВПР не летуча.
...
Рейтинг: 0 / 0
23.10.2011, 05:58
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37494177
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Т.е. сперва тянете данные кучей ВПР(), потом меняете их на значения?
Можно сразу всё взять кодом, но нужен пример в файле.
...
Рейтинг: 0 / 0
23.10.2011, 13:10
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37494324
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
AndreTM
Участник
Serge 007,

а, да, тормознул... суббота была
...
Рейтинг: 0 / 0
23.10.2011, 17:37
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37494448
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kuklp
Гость
Так или иначе, выложи автор свой пример в виде файла, наверняка получил бы уже несколько конкретных решений. Шокер, не сочти это за критику в твой адрес. Твоя реплика тривиальна и(а значит) безусловно верна. Давайте подождем автора.
...
Рейтинг: 0 / 0
23.10.2011, 21:09
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495734
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
Огромное спасибо всем за советы...но у меня возникла идея совсем от ВПР отказаться...ибо долго он считает( мне так кажется)...проверял отключением авторасчета...и все мгновенно вставилось, но одно и то же (я формулу растягивал по диапазону)..В целом у меня дело обстоит так:
Есть Файл №1. Так вот на листе 1 есть три таблицы. На листе 2 - только одна. На листе 3 как должно получиться.
Таблица вида:
1 текст число
1 текст число
1 текст число
2 текст число
2 текст число
2 текст число
3 текст текст
3 текст текст
Задача: Сделать выборку данных, затем автоматом их распихать по трем соответствующим таблицам ( для данных напротив 1 , 2 и 3)
Затем удалить пустые строки и обрамить...
Вопрос выборки сначала попробовал решить ВПР - но долго. - соответственно вопрос выборки - не решил))
Вопрос удаления строк - решил
Вопрос обрамления - решил
Так вот есть код
Код: plaintext
1.
2.
3.
4.
5.
6.
Sheets("Лист2").Select
    Range("B1:D14").Copy
    Sheets("Лист1").Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

Так вот теперь самый главный вопрос: Как мне привязать номер строки к значению в первом столбце?
чтобы Range("B1:D14") - был динамическим, а именно только последняя строка...тоесть (B1:Di ) где i Меняется в зависимости от значения в первом столбце..
может как то так, например для первой таблицы: пишу словами, т.к. не знаю как это выдать на языке VBA
Код: plaintext
1.
2.
3.
4.
i = переменная
Если Cells(i , 1 ).Text =  1     - если значение в первом столбце равно  1 
Тогда Count(i)      -  считать кол-во строк(i) где в первом столбце встретилось значение  1   (например   10  строк)
Затем Range("B1:Di").Copy    - копировать данный диапазон, ну и далее я вроде разобрался...
Потом..для второй таблицы т.к. после строк со значением 1 в таблице сразу идут строки со значением 2, тогда:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
j = переменная
s= переменная
e=переменная
Тогда j = i +  1       -  задаем первую строку со значением "2", которая идёт сразу же после i
Если Cells(s , 1 ).Text =  2     - если значение в первом столбце равно  2 
Тогда Count(s)      -  считать кол-во строк(s) где в первом столбце встретилось значение  2    (например он выдаст  15  строк)
е = i + s         -  последняя строка со значением  2   (т.к. первые  10  строк(i) - были под значение"1" и следующие за ними строки (s) со значением "2")
Затем Range("Bj:De").Copy    - копировать данный диапазон, ну и далее как вставить я разобрался
Вот , а для третьей таблицы так:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
с=переменная
d=переменная
f= переменная
с=e +  1      - так как строки со знач "3" идут сразу после строк со знач "2"
Если Cells(d , 1 ).Text =  3     - если значение в первом столбце равно  3 
Тогда Count(d)      -  считать кол-во строк(d) где в первом столбце встретилось значение  3    (например он выдаст  5  строк)
Затем 
f = e + d
Затем Range("Bc:Df").Copy

вот...помогите теперь всё это на язык VBA перевести)
файл приложил
...
Рейтинг: 0 / 0
24.10.2011, 17:42
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495757
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Я толком не понял - что есть и что нужно получить?
Как понял - есть данные на листе2 и пустые таблицы на листе1.
Зачем пустые и нельзя ли их генерить макросом как нужно (чтоб не искать, что удалять)?
Зачем вообще лист3 и что на нём уже есть, а что добавляется макросом (и зачем)?
...
Рейтинг: 0 / 0
24.10.2011, 17:57
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495788
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
... мне кажется, что можно сделать быстро на массивах и словаре/коллекции.
Но объясните, что именно нужно.
...
Рейтинг: 0 / 0
24.10.2011, 18:22
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495800
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
на листе 3 - образец что должно получиться, так сказать наглядный пример.
А нужно след.:
Нужно данные из одной таблицы, рассортировать по трем разным таблицам. Из условия что в первую таблицу заносятся данные если на листе 2 (в ОБЩЕЙ таблице) напротив этих данных в столбце 1 (A) стоит значение 1, во вторую таблицу заносятся данные если на листе 2 (в ОБЩЕЙ таблице) напротив этих данных в столбце 1 (A) стоит значение 2, в третью таблицу заносятся данные если на листе 2 (в ОБЩЕЙ таблице) напротив этих данных в столбце 1 (A) стоит значение 3
...
Рейтинг: 0 / 0
24.10.2011, 18:30
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495887
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
что значит на массивах и коллекциях/словарях?
мне хочется запустить импорт данных одним нажатием кнопки...а это ж только макросом и можно сделать...вот сначала записал макрос с впр, но долго...руками быстрее...теперь пытаюсь осилить более оптимизированный код...
Если есть решения ещё проще я бы был вам очень благодарен, если бы Вы меня направили в нужное русло...я не прошу мне код готовый прислать, мне в принципе самому интересно разобраться, хотя в программировании я полный профан...))
...
Рейтинг: 0 / 0
24.10.2011, 19:29
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495907
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kuklp
Гость
Hugo121... мне кажется, что можно сделать быстро на массивах и словаре/коллекции.
Но объясните, что именно нужно.
 
Я фигею. Игорь, ну наф... зачем? Почему не дать автору высказаться? Ты же умничка! Такое ощущение, что мне в пику делаешь.
...
Рейтинг: 0 / 0
24.10.2011, 19:37
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495948
R Dmitry
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
R Dmitry
Участник
kuklp, Привет Сергей !
Я для себя такой алгоритм нарисовал :
ADO
2 рекордсета: 1 - группируем по F1 и заодно подсчитываем значения(для смещения диаапзона вставки)
2- делаем единый формат таблицы из 3 столбов
затем перебираем 1 рекордсет, 1 значением фильтруем 2 рекордсет
выгружаем на лист, берем значение из первого рекордсета и смещаем точку вставки следующей таблицы,
так границы таблиц определены не составляет труда после вставки таблицы, отформатировать ее как надо.(добавить заголовки и стили)

как то так, но писать лениво -Q
...
Рейтинг: 0 / 0
24.10.2011, 20:20
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495953
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Сергей, так я дал. Полчаса :)
И всё равно до конца не понятно - эти значения 1, 2 и 3 - заранее известны, и по ним нужно отбирать?
Столбцы A и B всегда заполнены, а числа могут быть или в C, или в D?

Если так, то просто - исходные данные в массив (словарь не нужен), создаём ещё 3 пустых таких же по размеру, но на 3 столбца (или 6 на 1 столбец).
И 3 переменных для подсчёта.
Перебираем первый массив, анализируем первый столбец. Набираем данные в пустые массивы, считаем количество в каждом (т.е. используем индекс и для заполнения, и потом для выгрузки - это по одной переменной на массив или параллельную пару массивов).
В итоге имеем 3 (или 6) массивов с данными, верхушку которых выгружаем куда нужно.
Вопрос - куда нужно?
Один под другим с промежутком в 2 строки или как?
Ну а красоту и рамки потом можно навести - координаты данных будут известны.
Find не нужен, один цикл не по листу, а по массиву - будет меньше секунды на 200 строк. Основное время вероятно натягивание рамок займёт :)
...
Рейтинг: 0 / 0
24.10.2011, 20:26
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37495967
kuklp
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
kuklp
Гость
Дима, Игорь - чесслово - рад вам! Но еще Шокер в теме написал(см. сообщение №2). Помимо моей радости от увиденного, давайте братья подождем автора?
П.С. Вы, безусловно, лучшие!
...
Рейтинг: 0 / 0
24.10.2011, 20:38
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37496006
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Geo28что значит на массивах?


Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
Option Explicit

Sub otbor()
    Dim arr, i&, ai&, bi&, ci&, b(), c(), poz&

    'отключаем обновление экрана - сэкономим миллисекунду, но не будет мигать
    Application.ScreenUpdating = False

    'данные в массив
    With Sheets( 2 )
        arr = .Range(.Range("A" & .Rows.Count).End(xlUp), .[D1]).Value
        'или так
        'arr = .Range(.[D1], .Range("A" & .Rows.Count).End(xlUp)).Value
        'или даже в данном случае так
        'arr = .[a1].CurrentRegion.Value
    End With

    'создаём пустые массивы, сразу с заголовком
    ReDim a( 1  To UBound(arr),  1  To  3 )
    a( 1 ,  1 ) = "ТЕКСТ": a( 1 ,  3 ) = "ЧИСЛО"
    b = a
    c = a

    'заголовок уже посчитаем
    ai =  1 
    bi =  1 
    ci =  1 

    'перебор массива
    For i =  1  To UBound(a)
        'отбор данных
        Select Case arr(i,  1 )
        Case  1 
            ai = ai +  1 
            a(ai,  1 ) = arr(i,  1 )
            a(ai,  2 ) = arr(i,  2 )
            a(ai,  3 ) = IIf(Len(arr(i,  3 )), arr(i,  3 ), arr(i,  4 ))
        Case  2 
            bi = bi +  1 
            b(bi,  1 ) = arr(i,  1 )
            b(bi,  2 ) = arr(i,  2 )
            b(bi,  3 ) = IIf(Len(arr(i,  3 )), arr(i,  3 ), arr(i,  4 ))
        Case  3 
            ci = ci +  1 
            c(ci,  1 ) = arr(i,  1 )
            c(ci,  2 ) = arr(i,  2 )
            c(ci,  3 ) = IIf(Len(arr(i,  3 )), arr(i,  3 ), arr(i,  4 ))
        End Select
    Next

    'выгрузка и сразу рамки
    poz =  1 
    With Sheets( 1 )
        With .Cells(poz,  1 )
            .Resize(ai,  3 ).Value = a
            .Resize(ai,  3 ).Borders.Weight = xlThin
            .Resize( 1 ,  3 ).Borders.Weight = xlMedium
        End With
        poz = poz + ai +  2 

        With .Cells(poz,  1 )
            .Resize(bi,  3 ).Value = b
            .Resize(bi,  3 ).Borders.Weight = xlThin
            .Resize( 1 ,  3 ).Borders.Weight = xlMedium
        End With
        poz = poz + bi +  2 

        With .Cells(poz,  1 )
            .Resize(ci,  3 ).Value = c
            .Resize(ci,  3 ).Borders.Weight = xlThin
            .Resize( 1 ,  3 ).Borders.Weight = xlMedium
        End With
    End With
    
    'включаем обновление экрана
    Application.ScreenUpdating = True
End Sub

Чего уж ждать, раз написано?
Не подойдёт ТС - может другим сгодится :)
...
Рейтинг: 0 / 0
24.10.2011, 21:24
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37496010
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Помарка, так нужно объявить:
Код: plaintext
Dim arr()
Будет в 2 раза быстрее бегать :)
...
Рейтинг: 0 / 0
24.10.2011, 21:26
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37496057
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Упс, ещё проглядел - 1, 2 и 3 ведь не нужно в массив забивать :(
Тогда этот блок должен быть таким - 3 строки изменил, 3 удалил:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
    'перебор массива
    For i =  1  To UBound(a)
        'отбор данных
        Select Case arr(i,  1 )
        Case  1 
            ai = ai +  1 
            a(ai,  1 ) = arr(i,  2 )
            a(ai,  3 ) = IIf(Len(arr(i,  3 )), arr(i,  3 ), arr(i,  4 ))
        Case  2 
            bi = bi +  1 
            b(bi,  1 ) = arr(i,  2 )
            b(bi,  3 ) = IIf(Len(arr(i,  3 )), arr(i,  3 ), arr(i,  4 ))
        Case  3 
            ci = ci +  1 
            c(ci,  1 ) = arr(i,  2 )
            c(ci,  3 ) = IIf(Len(arr(i,  3 )), arr(i,  3 ), arr(i,  4 ))
        End Select
    Next
...
Рейтинг: 0 / 0
24.10.2011, 22:05
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37496087
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
ВЫ реально лучшие, СПАСИБО ВАМ ОГРОМНОЕ ЗА ПОМОЩЬ...
Но я чесслово вообще ничего не понял))))) Все что связано с массивами))) Но это круто...То что вы так вот сходу такие темы лабаете - это круто...Респект))
Но позвольте, мне еще тогда раз все более подробно разъяснить, а то вижу что люди мне пытаются помочь, а я блин толком не могу рассказать что мне надо...Итак ещё раз о моей задаче:
У меня есть файл, допустим он называется Книга1.
В нем на первом листе есть таблицы, которые необходимо заполнить. Таблиц три штуки, идут они друг за другом, в конце каждой таблицы есть итог. (пример я прикрепил). Тоесть если в табличке в столбце числа идут 1,2,3 то в графе ИТОГ в конце будет их сумма - 6. Графа "Итог" должна быть в конце обязательно, поэтому я и сделал сначала в каждой таблице пустых строк с запасом, а потом просто их удалить по условию, что в них стоит "0" в графе число...
Теперь как формируются данные на листе 2. Таблица всегда одного вида. НИКОГДА не меняются столбцы. Никогда не меняется условие отбора - это всегда числа в первом столбце либо 1, либо 2, либо 3. Но количество строк с каждым числом может меняться...В примере на листе 2 я привел пример...Нарисовал две таблицы какие они могут быть...
Теперь что куда надо импортировать:
Например для первой таблицы
грубо говоря по аналогии с формулой впр: если в таблице на листе2 в столбце A:A, есть число 2, то нужно скопировать из этой строки данные их столбцов D и G в соответственно первую таблицу на первом листе в первую строку в столбцы A и D (как в прикрепленном примере)
Руками я делаю так: выделяю массив данных все что напротив Числа 2 из первого столбца, потом Ctrl+C, перехожу на самую верхнюю и левую ячейку первой таблицы Ctrl+V...потом удалял пустые строки и обрамлял. Вот и все и так для каждой таблицы.
Надеюсь что Вы меня поняли...
...
Рейтинг: 0 / 0
24.10.2011, 22:26
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37496101
Geo28
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Geo28
Гость
Мне самое главное это тупо отобрать массив, это если бы я руками выделял по условию все напротив 1, 2 или 3
и тупо вставить в верхнюю левую ячейку соответствующей таблицы...Мне нельзя формировать таблицы с нуля...Есть форма, но она пустая, в ней набито пустых строк с запасом..., надо просто выделить отобранный массив и вставить, потом удалить пустые строки, и обрамить вставленный ранее массив, ну либо последнюю строку обрамить снизу( ну после которой идёт графа Итог). Мне кажется это самый простой вариант...
...
Рейтинг: 0 / 0
24.10.2011, 22:36
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37496109
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Geo28,
Примерно понятно.
Не понятно, почему нельзя генерить таблицу? В ней ещё что-то есть?
Столбец "Номер" вообще не учитывается?
Итого можно сразу при заполнении массива считать - ещё 3 переменных для этого завести.
Т.е. таблицы на первом листе легко генерить кодом, это просто.
Сложнее сделать заливку - она и впрямь нужна? Лениво прописывать... :)
И рамки тоже сложные - в первом варианте проще было.
И объединение ячеек...
Давайте это Вам домашнее задание? :)
...
Рейтинг: 0 / 0
24.10.2011, 22:40
| Ответить | Цитировать | Написать  
Помогите ускорить код пожалуйста!
    #37496116
Hugo121
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hugo121
Гость
Нет, номер учитывается в таблице №3, куда забиваются данные №1, так :)
...
Рейтинг: 0 / 0
24.10.2011, 22:44
| Ответить | Цитировать | Написать  
25 сообщений из 57, страница 1 из 3
  1  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите ускорить код пожалуйста!
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&fpage=117&tid=2176354]:
 0ms
get settings:
 7ms
get forum list:
 21ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 50ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 65ms
get tp. blocked users:
 2ms
others: 213ms
total:  375ms
созд. / загр.: 375ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]