Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование диапазона по условию
 
#1
09.12.2018 12:32:30
Здравствуйте. Подскажите решение следующей задачи. Имеется несколько диапазонов с данными. Под диапазонами указано количество непустых ячеек в каждом среднем столбце диапазона. Необходимо по условию, если это количество равно 6, скопировать каждый из таких диапазонов и вставить в другое место таблицы, как показано
на скриншоте:
 
Код
Private Sub CommandButton1_Click()
For i = 3 To 16 Step 4
If Cells(17, i) = 6 Then

End If
Next i
End Sub
Изменено: Обамка - 09.12.2018 12:33:09
 
 
 
#2
09.12.2018 13:16:14
Код
Private Sub CommandButton1_Click()
Dim i As Long, FreeColumn As Long
    FreeColumn = 2
    For i = 3 To 15 Step 4
        If Cells(17, i) = 6 Then
            Range(Cells(2, i - 1), Cells(16, i + 1)).Copy Cells(19, FreeColumn)
            FreeColumn = FreeColumn + 4
        End If
    Next
End Sub
 
 
 
#3
09.12.2018 15:55:41
Спасибо. Только вот если много таких вот диапазонов, то процесс выполнения макроса очень медленный.
Может через массивы как-то. Только сам я не соображаю, уж извините.  
Изменено: Обамка - 09.12.2018 16:00:40
 
 
 
#4
09.12.2018 16:05:33
Цитата
Обамка написал:
процесс выполнения макроса очень медленный
У Вас там наверное формул на листе много?  
 
 
 
#5
09.12.2018 16:10:09
Очень медленно - это сколько? И для какого количества столбцов?
Не проверял, но мы же не по одной ячейке копируем, а целые диапазоны.
Попробуйте так: вместо диапазонов массивы. Но форматирование будет потеряно:
Код
Private Sub CommandButton1_Click()
Dim i As Long, FreeColumn As Long, Arr()
    FreeColumn = 2
    For i = 3 To 15 Step 4
        If Cells(17, i) = 6 Then
            Arr = Range(Cells(2, i - 1), Cells(16, i + 1)).Value
            Cells(19, FreeColumn).Resize(15, 3).Value = Arr
            FreeColumn = FreeColumn + 4
        End If
    Next
End Sub
 
 
 
#6
09.12.2018 16:17:53
Юрий М, я дико извиняюсь, но разницы между #2 и #5 не видно...
 
 
 
#7
09.12.2018 16:22:55
Не тот код скопировал ))  
 
 
 
#8
09.12.2018 16:23:59
Цитата
_Igor_61 написал:
У Вас там наверное формул на листе много?  
Нет, формул две всего и то для примера. Пример прикрепляю ниже.  
 
 
 
#9
09.12.2018 16:31:32
Ну, спасибо за помощь. Диапазонов действительно может быть около 2000, если на лист залезут. Потеря форматирования не очень страшна.  
 
 
 
#10
09.12.2018 16:35:00
Проверил на втором файле два варианта - оба работают очень быстро.
 
 
 
#11
09.12.2018 16:42:13
Второй вариант выполняется мгновенно. Но без форматирования. Я думал только заливка ячеек потеряется. Ну ладно, и так сойдет тоже.  
 
 
 
Страницы: 1
Наверх