Как я понял, без цикла можно обойтись только создавая лист, как тут показал Игорь — быстро, просто и надёжно. В том числе, я остановил своё внимание на ещё 2х решениях: сбор диапазонов в Union циклом, как тут и решение от Дмитрия «The_Prist» Щербакова через массивы (в комментариях есть вариант от того же Alex_ST с созданием листа).
Собственно, задача сводиться к простому условию: есть область rngBig, в которой есть область или области rngSmall Вопрос: как быстро и эффективно получить диапазон rngNew, состоящий из одной или более областей, rngBig исключая при этом входящие в него rngSmall? Может у кого-то есть новые свежие решения, способы или методы…
ВАЖНО! Пример с цветами просто для наглядности. Считаем, что мы передаём в макрос rngBig и rngSmall (известные диапазоны) и они усечены до UsedRange листа, т.к. рассматривать выделение ВСЕГО листа (rngBig=Cells) за исключением rngSmall проще и быстрее реализовать созданием нового листа.
Интересны именно новые методы, отличные от описанных в шапке Пока я лично для себя остановился на сборе циклом в Union…
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Jack Famous написал: есть область rngBig, в которой есть область или области rngSmall
исходя из этого условия само итоговое условие невыполнимо:
Цитата
Jack Famous написал: одновременно входящих в rngBig и не входящих в rngSmall
Я так понимаю надо это: получить rngBig исключая при этом входящие в него rngSmall? Или я чего-то не понимаю... И главное: как код должен определить где какой диапазон? Только по цвету?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Функция RngMinusRng возвращает разность множеств ячеек любых диапазонов Rng1 и Rng2 (принадлежащих одному рабочему листу). Процедура Test закрашивает желтым цветом разность UsedRange и Selection. Ссылки в #1 внимательно не смотрел.
Код
Option Explicit
' Returns Rng1 Minus Rng2
Function RngMinusRng(ByVal rng1 As Range, ByVal rng2 As Range) As Range
Dim r As Range, ra As Range, r2 As Range
Dim nrows As Long, ncols As Long, i As Long, j As Long
With rng1.Parent
nrows = .Rows.Count
ncols = .Columns.Count
Set RngMinusRng = rng1
Set r = Intersect(rng1, rng2)
If r Is Nothing Then ' диапазоны не пересекаются
Exit Function
End If
For Each ra In r.Areas
Set r2 = Nothing
i = ra.Row + ra.Rows.Count
j = ra.Column + ra.Columns.Count
If ra.Column > 1 Then Set r2 = Union2(r2, .Range(.Cells(1, 1), .Cells(nrows, ra.Column - 1)))
If ra.Row > 1 Then Set r2 = Union2(r2, .Range(.Cells(1, ra.Column), .Cells(ra.Row - 1, ncols)))
If j <= ncols Then Set r2 = Union2(r2, .Range(.Cells(ra.Row, j), .Cells(i - 1, ncols)))
If i <= nrows Then Set r2 = Union2(r2, .Range(.Cells(i, ra.Column), .Cells(nrows, ncols)))
Set RngMinusRng = Intersect(RngMinusRng, r2)
Next ra
End With
End Function
Private Function Union2(r1 As Range, r2 As Range) As Range
If r1 Is Nothing Then
Set Union2 = r2
Else
Set Union2 = Union(r1, r2)
End If
End Function
' Вычитает из UsedRange Selection и отображает цветoм
Sub test()
Dim r As Range, ra As Range
With ActiveSheet.Cells.Interior
.Pattern = xlNone: .TintAndShade = 0: .PatternTintAndShade = 0
End With
RngMinusRng(Selection.Parent.UsedRange, Selection).Interior.Color = vbYellow
End Sub
sokol92, как интересно)) спасибо большое! особенно крутая находка - записать отдельной функцией (Union2) проверку диапазона при накоплении в Union Как проверю - отпишусь!
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Const ColorIndex As Long = 33
Sub Выдел()
Dim sh As Worksheet: Set sh = ActiveSheet
Dim rng As Range, rngFilt As Range, rngFilt_Vis As Range
Set rng = sh.UsedRange
Dim r As Long, c As Long
With rng
For c = 1 To .Columns.Count
For r = 1 To .Rows.Count
If .Cells(r, c).Interior.ColorIndex = ColorIndex Then
Set rngFilt = Range(.Cells(r, c), .Cells(.Rows.Count, c))
With rngFilt
.AutoFilter Field:=1, _
Criteria1:=RGB(0, 176, 240), _
Operator:=xlFilterCellColor
Set rngFilt_Vis = .SpecialCells(xlCellTypeVisible)
rngFilt_Vis.Value = 0
.AutoFilter
End With 'rngFilt
Exit For
End If
Next
Next
Set rng = rng.SpecialCells(xlCellTypeBlanks)
rng.Select
.ClearContents
End With
End Sub
sokol92, лень — двигатель прогресса Именно по этой причине в своей настройке я создал модули со "служебными" макросами и функциями (это как Union2 у вас), которые я вызываю во всех других
Inexsu, спасибо за пример с автофильтром (необычно) , только эта цветная пустая табличка просто для визуализации диапазонов. Мой косяк, поправил шапку
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄