Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Makroshka
0 / 0 / 0
Регистрация: 26.09.2016
Сообщений: 111
1

Зависает макрос на выделение диапазона ячеек

17.08.2018, 16:46. Просмотров 156. Ответов 9
Метки нет (Все метки)

Создала макрос на выделение ячеек через одну. Тестировала на таблице с 20-ю строками - все работает. А на 300тыс.+ зависает намертво. Как можно ускорить работу макроса?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Рандом()
'
Dim LastRow As Long, i&, diapaz1 As Range, diapaz2 As Range
 
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' последняя строка
Range(Cells(1, 1), Cells(LastRow, 1)).Select
Set diapaz1 = Application.Intersect(Selection, ActiveSheet.UsedRange) ' диапазон со всеми выделенными ячейками
    For i = 1 To LastRow Step 2 ' цикл по массиву
        If diapaz2 Is Nothing Then
         Set diapaz2 = diapaz1(i) ' дизапазон только с ячейками через одну 
         Else
         Set diapaz2 = Application.Union(diapaz2, diapaz1(i))
        End If
    Next
  diapaz2.Select
End Sub
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
17.08.2018, 16:46
Ответы с готовыми решениями:

Выделение диапазона ячеек
Всем доброго дня. Имеется...

Выделение диапазона ячеек без фиксированных границ
Сильно не пинайте новичка. Подскажите, как выделить диапазон ячеек с правой...

Выделение ячеек цветом, в зависсимости от диапазона цифр
Рябята, совсем запарился! Есть определенное количество строк цифр: 0 2 13...

VBA снять выделение цветом отдельных ячеек диапазона
Здравствуйте! Снова задаю неумный вопрос. :sorry: Подскажите как снять...

Макрос для подсчета среднего геометрического выделенного диапазона ячеек
Здравствуйте!буду очень признательна если поможете в написании макроса,нужен...

9
fever brain
oh my god
1128 / 600 / 117
Регистрация: 05.01.2016
Сообщений: 1,842
Записей в блоге: 7
17.08.2018, 20:45 2
Может отказаться от использования метода union
для того чтобы выделить рванный диапазон можно записать в аргументах range
отключить реакцию листа и не использовать цикл
0
Казанский
14313 / 5930 / 1571
Регистрация: 24.09.2011
Сообщений: 9,342
17.08.2018, 23:38 3
Makroshka, конечная цель, наверно, не в том, чтобы создать диапазон из сотни тысяч несмежных ячеек. А в чем?
0
Makroshka
0 / 0 / 0
Регистрация: 26.09.2016
Сообщений: 111
21.08.2018, 12:18  [ТС] 4
Как раз в этом и есть цель. Макрос задумывался для деления больших сегментов на два путем рандома. Я решила, что деление через 1 наиболее рандомно. Эти ячейки потом надо будет вырезать и вставить в другой файл.
0
Казанский
14313 / 5930 / 1571
Регистрация: 24.09.2011
Сообщений: 9,342
21.08.2018, 13:06 5
Цитата Сообщение от Makroshka Посмотреть сообщение
Макрос задумывался для деления больших сегментов на два путем рандома
Вот это - цель Можно работать с массивами, например раскидать в столбцы С и Е
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Рандом1()
'
Dim LastRow As Long, i&, k&, v()
 
  LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' последняя строка
  v = Range(Cells(1, 1), Cells(LastRow, 1)).Value
  ReDim x(1 To (UBound(v) + 1) \ 2, 1 To 1), y(1 To (UBound(v) + 1) \ 2, 1 To 1)
  On Error Resume Next
  For i = 1 To LastRow Step 2
    k = k + 1
    x(k, 1) = v(i, 1): y(k, 1) = v(i + 1, 1)
  Next
  Range("C1").Resize(UBound(x)).Value = x
  Range("E1").Resize(UBound(y)).Value = y
End Sub
1
Makroshka
0 / 0 / 0
Регистрация: 26.09.2016
Сообщений: 111
21.08.2018, 14:25  [ТС] 6
Спасибо) В таком варианте моментально делит сегмент.

Добавлено через 32 минуты
А можете помочь с чтением кода?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Рандом1()
'
Dim LastRow As Long, i&, k&, v()
 
  LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' последняя строка
  v = Range(Cells(1, 1), Cells(LastRow, 1)).Value ' массив значений из диапазона
  ReDim x(1 To (UBound(v) + 1) \ 2, 1 To 1), y(1 To (UBound(v) + 1) \ 2, 1 To 1) ' это не очень поняла. Разве можно назначать значение массив без равенства? Смысл назначать два  массива, если они абсалютно идентичны?
  On Error Resume Next ' если ошибка - следующий
  For i = 1 To LastRow Step 2 ' цикл по диапазону с шагом через один
    k = k + 1 ' ???
    x(k, 1) = v(i, 1): y(k, 1) = v(i + 1, 1) ' ???
  Next
  Range("C1").Resize(UBound(x)).Value = x ' вставка массива
  Range("E1").Resize(UBound(y)).Value = y ' вставка массива
End Sub
0
borro
37 / 5 / 3
Регистрация: 30.11.2011
Сообщений: 360
21.08.2018, 16:59 7
Цитата Сообщение от Makroshka Посмотреть сообщение
x(k, 1) = v(i, 1): y(k, 1) = v(i + 1, 1) ' ???
я бы тоже хотел узнать, что происходит в этой необычной строке
0
Казанский
14313 / 5930 / 1571
Регистрация: 24.09.2011
Сообщений: 9,342
21.08.2018, 17:08 8
Цитата Сообщение от Makroshka Посмотреть сообщение
это не очень поняла. Разве можно назначать значение массив без равенства?
Почитайте какой-нибудь букварь по VBA или VB6.
Здесь создаются 2 массива-столбца, т.е. двумерные массивы с одним элементом в строке. Их размер в 2 раза меньше исходного (с учетом округления вверх для нечетного размера исходного массива). В цикле элементы с нечетными номерами копируются в массив х, с четными номерами - в массив у. к - очередной первый индекс (номер строки) заполняемых массивов.
0
borro
37 / 5 / 3
Регистрация: 30.11.2011
Сообщений: 360
21.08.2018, 18:06 9
Спасибо, Казанский. А в чем смысл было записать через :, а не двумя строками?
0
Казанский
14313 / 5930 / 1571
Регистрация: 24.09.2011
Сообщений: 9,342
21.08.2018, 18:10 10
borro, так рука взяла Можно найти смысл в том, что это однородные действия.
1
21.08.2018, 18:10
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
21.08.2018, 18:10

Макрос выделения диапазона ячеек-объединение их в одну-переход на след.строку-повтор пред.действия
Добрый день. Помогите плиз решить задачу. Я с VBA столкнулся впервые 1) в...

Макрос для пересчета взаимозависимых ячеек ячеек
Добрый вечер, уважаемые форумчане. Помогите, пожалуйста, реализовать следующую...

Заполнение диапазона ячеек
Запросите у пользователя диапазон ячеек и заполните его случайными цифрами от 0...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru