Перенос данных после автофильтра
berya
Дата: Вторник, 28.08.2018, 13:22 |
Сообщение № 1
Группа: Проверенные
Ранг: Новичок
Сообщений: 27
Репутация:
0
±
Замечаний:
0% ±
Excel 2007
Добрый день. Есть рабочий макрос по жеребьевке спортсменов. Обработка идёт путем переборки необходимых разделов (К-1, ЛОУ-кик, Фул) по циклам с учетом возрастных (параметр "j") и весовых категорий (параметр "i") с вложенными циклами с копированием на соответствующие листы. При этом данные переносятся через буфер обмена, что тормозит систему. Есть ли вариант обрабатывать данные через массив для ускорения работы Заранее благодарен.
Добрый день. Есть рабочий макрос по жеребьевке спортсменов. Обработка идёт путем переборки необходимых разделов (К-1, ЛОУ-кик, Фул) по циклам с учетом возрастных (параметр "j") и весовых категорий (параметр "i") с вложенными циклами с копированием на соответствующие листы. При этом данные переносятся через буфер обмена, что тормозит систему. Есть ли вариант обрабатывать данные через массив для ускорения работы Заранее благодарен. berya
Сообщение отредактировал berya - Вторник, 28.08.2018, 16:03
Ответить
Сообщение Добрый день. Есть рабочий макрос по жеребьевке спортсменов. Обработка идёт путем переборки необходимых разделов (К-1, ЛОУ-кик, Фул) по циклам с учетом возрастных (параметр "j") и весовых категорий (параметр "i") с вложенными циклами с копированием на соответствующие листы. При этом данные переносятся через буфер обмена, что тормозит систему. Есть ли вариант обрабатывать данные через массив для ускорения работы Заранее благодарен. Автор - berya Дата добавления - 28.08.2018 в 13:22
_Boroda_
Дата: Вторник, 28.08.2018, 13:41 |
Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация:
6478
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
Конкретный вопрос по теме Цитата
Перенос данных после автофильтра
какой?
Конкретный вопрос по теме Цитата
Перенос данных после автофильтра
какой? _Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение Конкретный вопрос по теме Цитата
Перенос данных после автофильтра
какой? Автор - _Boroda_ Дата добавления - 28.08.2018 в 13:41
berya
Дата: Вторник, 28.08.2018, 13:59 |
Сообщение № 3
Группа: Проверенные
Ранг: Новичок
Сообщений: 27
Репутация:
0
±
Замечаний:
0% ±
Excel 2007
После автфильтра переносится по листам. В данном случае листы: [vba]Код
iList = Array("К_1_Б", "Лоу_Кік_Б", "ФК_Б")
[/vba]. алгоритм - проходит по категории К-1 - возрастные категории от 1 до 4 параметр в цикле "j" - если находит проходит весовые категории - параметр "i". и переносит на соответствующий лист. После этого идет обработка по ЛОУ-КИК и Фул
После автфильтра переносится по листам. В данном случае листы: [vba]Код
iList = Array("К_1_Б", "Лоу_Кік_Б", "ФК_Б")
[/vba]. алгоритм - проходит по категории К-1 - возрастные категории от 1 до 4 параметр в цикле "j" - если находит проходит весовые категории - параметр "i". и переносит на соответствующий лист. После этого идет обработка по ЛОУ-КИК и Фул berya
Сообщение отредактировал Pelena - Воскресенье, 02.09.2018, 06:29
Ответить
Сообщение После автфильтра переносится по листам. В данном случае листы: [vba]Код
iList = Array("К_1_Б", "Лоу_Кік_Б", "ФК_Б")
[/vba]. алгоритм - проходит по категории К-1 - возрастные категории от 1 до 4 параметр в цикле "j" - если находит проходит весовые категории - параметр "i". и переносит на соответствующий лист. После этого идет обработка по ЛОУ-КИК и Фул Автор - berya Дата добавления - 28.08.2018 в 13:59
_Boroda_
Дата: Вторник, 28.08.2018, 14:42 |
Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация:
6478
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
berya , почти 5 лет!!! на форуме, а Правила до сих пор не прочитали?
berya , почти 5 лет!!! на форуме, а Правила до сих пор не прочитали?_Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение berya , почти 5 лет!!! на форуме, а Правила до сих пор не прочитали?Автор - _Boroda_ Дата добавления - 28.08.2018 в 14:42
berya
Дата: Вторник, 28.08.2018, 15:01 |
Сообщение № 5
Группа: Проверенные
Ранг: Новичок
Сообщений: 27
Репутация:
0
±
Замечаний:
0% ±
Excel 2007
_Boroda_, простите, но не совсем понимаю какой именно пункт не соблюден?
_Boroda_, простите, но не совсем понимаю какой именно пункт не соблюден? berya
Ответить
Сообщение _Boroda_, простите, но не совсем понимаю какой именно пункт не соблюден? Автор - berya Дата добавления - 28.08.2018 в 15:01
_Boroda_
Дата: Вторник, 28.08.2018, 15:26 |
Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация:
6478
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
3
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение 3 Автор - _Boroda_ Дата добавления - 28.08.2018 в 15:26
berya
Дата: Вторник, 28.08.2018, 15:41 |
Сообщение № 7
Группа: Проверенные
Ранг: Новичок
Сообщений: 27
Репутация:
0
±
Замечаний:
0% ±
Excel 2007
_Boroda_ , П. 3. Кратко, но ёмко опишите задачу в теле поста - оптимизация работы макроса ВСЕГДА прикладывайте файл-пример - файл приложен
_Boroda_ , П. 3. Кратко, но ёмко опишите задачу в теле поста - оптимизация работы макроса ВСЕГДА прикладывайте файл-пример - файл приложенberya
Ответить
Сообщение _Boroda_ , П. 3. Кратко, но ёмко опишите задачу в теле поста - оптимизация работы макроса ВСЕГДА прикладывайте файл-пример - файл приложенАвтор - berya Дата добавления - 28.08.2018 в 15:41
StoTisteg
Дата: Вторник, 28.08.2018, 15:49 |
Сообщение № 8
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация:
103
±
Замечаний:
0% ±
Excel 2010
berya , это кратко, ёмко и не имеет отношения к теме
berya , это кратко, ёмко и не имеет отношения к теме StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Ответить
Сообщение berya , это кратко, ёмко и не имеет отношения к теме Автор - StoTisteg Дата добавления - 28.08.2018 в 15:49
InExSu
Дата: Суббота, 01.09.2018, 22:50 |
Сообщение № 9
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация:
96
±
Замечаний:
0% ±
Excel 2010, 365
Привет! Давайте попробуем набить Вам ... руку на избавление от Select Пожалуйста, замените [vba]Код
Sub shapka() ... End Sub
[/vba] на [vba]Код
Sub shapka(rng As Range) With rng .Borders.LineStyle = True .Borders.Weight = xlThin .Interior.ColorIndex = 35 .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlCenter With .Font .Name = "Cambria" .FontStyle = "обычный" .Size = 10 .Bold = True End With End With End Sub
[/vba] И к вызову shapka добавьте Selection. Должно получиться: [vba]Код
'''--------------------------------------------------------------------------------------- shapka Selection '''---------------------------------------------------------------------------------------
[/vba] Если получится, продолжим ...
Привет! Давайте попробуем набить Вам ... руку на избавление от Select Пожалуйста, замените [vba]Код
Sub shapka() ... End Sub
[/vba] на [vba]Код
Sub shapka(rng As Range) With rng .Borders.LineStyle = True .Borders.Weight = xlThin .Interior.ColorIndex = 35 .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlCenter With .Font .Name = "Cambria" .FontStyle = "обычный" .Size = 10 .Bold = True End With End With End Sub
[/vba] И к вызову shapka добавьте Selection. Должно получиться: [vba]Код
'''--------------------------------------------------------------------------------------- shapka Selection '''---------------------------------------------------------------------------------------
[/vba] Если получится, продолжим ... InExSu
Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
Ответить
Сообщение Привет! Давайте попробуем набить Вам ... руку на избавление от Select Пожалуйста, замените [vba]Код
Sub shapka() ... End Sub
[/vba] на [vba]Код
Sub shapka(rng As Range) With rng .Borders.LineStyle = True .Borders.Weight = xlThin .Interior.ColorIndex = 35 .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlCenter With .Font .Name = "Cambria" .FontStyle = "обычный" .Size = 10 .Bold = True End With End With End Sub
[/vba] И к вызову shapka добавьте Selection. Должно получиться: [vba]Код
'''--------------------------------------------------------------------------------------- shapka Selection '''---------------------------------------------------------------------------------------
[/vba] Если получится, продолжим ... Автор - InExSu Дата добавления - 01.09.2018 в 22:50
InExSu
Дата: Суббота, 01.09.2018, 23:09 |
Сообщение № 10
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация:
96
±
Замечаний:
0% ±
Excel 2010, 365
Код от [vba]Код
Gr = Sheets("список").Range("K3").End(xlDown).Value ' по Range("A4:K4").Resize(v).Copy Worksheets(Sname).Range(D)
[/vba] Попробуйте заменить на [vba]Код
Gr = Sheets("список").Range("K3").End(xlDown).Value With Sheets(Sname) With .Range("E65535") x = .End(xlUp).Row 'строка y = .End(xlUp).Column 'столбец D = .End(xlUp).Address(0, 0) End With With .Cells(x + 2, y - 4) .Resize(1, 14).Merge .FormulaR1C1 = UCase(param & " серед:" & " " & rn & " " & rn1 & " " & " - " & " " & rn2 & " " & "років," & " " & "Вагова категорія" & " " & VG2 & " " & VG1 & " " & "кг." & ", група" & " " & """" & Gr & """") shapka .Resize(1, 14) End With D = .Range("A65535").End(xlUp).Offset(1, 0).Offset(0, 4).Address(0, 0) ' Call Rng2Array(Список.AutoFilter.Range.SpecialCells(xlCellTypeVisible), 0, .Range(D)) v = Sheets("список").Range("A65535").End(xlUp).Row Sheets("список").Range("A4:K4").Resize(v).Copy .Range(D) End With
[/vba]
Код от [vba]Код
Gr = Sheets("список").Range("K3").End(xlDown).Value ' по Range("A4:K4").Resize(v).Copy Worksheets(Sname).Range(D)
[/vba] Попробуйте заменить на [vba]Код
Gr = Sheets("список").Range("K3").End(xlDown).Value With Sheets(Sname) With .Range("E65535") x = .End(xlUp).Row 'строка y = .End(xlUp).Column 'столбец D = .End(xlUp).Address(0, 0) End With With .Cells(x + 2, y - 4) .Resize(1, 14).Merge .FormulaR1C1 = UCase(param & " серед:" & " " & rn & " " & rn1 & " " & " - " & " " & rn2 & " " & "років," & " " & "Вагова категорія" & " " & VG2 & " " & VG1 & " " & "кг." & ", група" & " " & """" & Gr & """") shapka .Resize(1, 14) End With D = .Range("A65535").End(xlUp).Offset(1, 0).Offset(0, 4).Address(0, 0) ' Call Rng2Array(Список.AutoFilter.Range.SpecialCells(xlCellTypeVisible), 0, .Range(D)) v = Sheets("список").Range("A65535").End(xlUp).Row Sheets("список").Range("A4:K4").Resize(v).Copy .Range(D) End With
[/vba] InExSu
Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
Ответить
Сообщение Код от [vba]Код
Gr = Sheets("список").Range("K3").End(xlDown).Value ' по Range("A4:K4").Resize(v).Copy Worksheets(Sname).Range(D)
[/vba] Попробуйте заменить на [vba]Код
Gr = Sheets("список").Range("K3").End(xlDown).Value With Sheets(Sname) With .Range("E65535") x = .End(xlUp).Row 'строка y = .End(xlUp).Column 'столбец D = .End(xlUp).Address(0, 0) End With With .Cells(x + 2, y - 4) .Resize(1, 14).Merge .FormulaR1C1 = UCase(param & " серед:" & " " & rn & " " & rn1 & " " & " - " & " " & rn2 & " " & "років," & " " & "Вагова категорія" & " " & VG2 & " " & VG1 & " " & "кг." & ", група" & " " & """" & Gr & """") shapka .Resize(1, 14) End With D = .Range("A65535").End(xlUp).Offset(1, 0).Offset(0, 4).Address(0, 0) ' Call Rng2Array(Список.AutoFilter.Range.SpecialCells(xlCellTypeVisible), 0, .Range(D)) v = Sheets("список").Range("A65535").End(xlUp).Row Sheets("список").Range("A4:K4").Resize(v).Copy .Range(D) End With
[/vba] Автор - InExSu Дата добавления - 01.09.2018 в 23:09
Pelena
Дата: Воскресенье, 02.09.2018, 06:30 |
Сообщение № 11
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация:
4412
±
Замечаний:
±
Excel 365 & Mac Excel
Код в третьем посте отредактировала, т.к. автор уже не сможет внести изменения в пост. На будущее: оформляйте коды и формулы тегами
Код в третьем посте отредактировала, т.к. автор уже не сможет внести изменения в пост. На будущее: оформляйте коды и формулы тегами Pelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Ответить
Сообщение Код в третьем посте отредактировала, т.к. автор уже не сможет внести изменения в пост. На будущее: оформляйте коды и формулы тегами Автор - Pelena Дата добавления - 02.09.2018 в 06:30
berya
Дата: Воскресенье, 02.09.2018, 09:34 |
Сообщение № 12
Группа: Проверенные
Ранг: Новичок
Сообщений: 27
Репутация:
0
±
Замечаний:
0% ±
Excel 2007
InExSu , Доброе утро. Ваш вариант работает. По поводу Select - согласен - стараюсь избавляться. У меня в этой процедуре самое слабое место - куча фильтров и копирование на другой лист. Я пытался передать результаты автофильтра через массивы. Но в некоторых местах у меня шло с ошибками - вернулся к проверенному варианту через COPY. Большое спасибо за внимание к моей проблеме
InExSu , Доброе утро. Ваш вариант работает. По поводу Select - согласен - стараюсь избавляться. У меня в этой процедуре самое слабое место - куча фильтров и копирование на другой лист. Я пытался передать результаты автофильтра через массивы. Но в некоторых местах у меня шло с ошибками - вернулся к проверенному варианту через COPY. Большое спасибо за внимание к моей проблемеberya
Ответить
Сообщение InExSu , Доброе утро. Ваш вариант работает. По поводу Select - согласен - стараюсь избавляться. У меня в этой процедуре самое слабое место - куча фильтров и копирование на другой лист. Я пытался передать результаты автофильтра через массивы. Но в некоторых местах у меня шло с ошибками - вернулся к проверенному варианту через COPY. Большое спасибо за внимание к моей проблемеАвтор - berya Дата добавления - 02.09.2018 в 09:34
berya
Дата: Воскресенье, 02.09.2018, 09:34 |
Сообщение № 13
Группа: Проверенные
Ранг: Новичок
Сообщений: 27
Репутация:
0
±
Замечаний:
0% ±
Excel 2007
Pelena , Доброе утро. Замечание принял - исправлюсь
Pelena , Доброе утро. Замечание принял - исправлюсьberya
Ответить
Сообщение Pelena , Доброе утро. Замечание принял - исправлюсьАвтор - berya Дата добавления - 02.09.2018 в 09:34