Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Как быстро, правильно и корректно инвертировать выделение, Как обратить диапазон
 
Доброго времени суток, Планетяне!

Хотелось бы оживить парочку родственных архивных тем:
Как расформатировать весь лист кроме выделенного диапазона? и
Как без цикла инвертировать выделение? — обе от Alex_ST.

Как я понял, без цикла можно обойтись только создавая лист, как тут показал  Игорь — быстро, просто и надёжно.
В том числе, я остановил своё внимание на ещё 2х решениях: сбор диапазонов в Union циклом, как тут и решение от Дмитрия «The_Prist» Щербакова через массивы (в комментариях есть вариант от того же Alex_ST с созданием листа).

Собственно, задача сводиться к простому условию: есть область rngBig, в которой есть область или области rngSmall
Вопрос: как быстро и эффективно получить диапазон rngNew, состоящий из одной или более областей, rngBig исключая при этом входящие в него rngSmall? Может у кого-то есть новые свежие решения, способы или методы…  :)

ВАЖНО! Пример с цветами просто для наглядности. Считаем, что мы передаём в макрос rngBig и rngSmall (известные диапазоны) и они усечены до UsedRange листа, т.к. рассматривать выделение ВСЕГО листа (rngBig=Cells) за исключением rngSmall проще и быстрее реализовать созданием нового листа.

Интересны именно новые методы, отличные от описанных в шапке  :)
Пока я лично для себя остановился на сборе циклом в Union…
1.png (17.04 КБ)
Изменено: Jack Famous - 22 Мар 2018 12:38:37
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Jack Famous написал:
есть область rngBig, в которой есть область или области rngSmall
исходя из этого условия само итоговое условие невыполнимо:
Цитата
Jack Famous написал:
одновременно входящих в rngBig и не входящих в rngSmall
Я так понимаю надо это: получить rngBig исключая при этом входящие в него rngSmall? Или я чего-то не понимаю...
И главное: как код должен определить где какой диапазон? Только по цвету?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий Щербаков, приветствую!
Цитата
Дмитрий Щербаков написал:
получить rngBig исключая при этом входящие в него rngSmall
всё верно. Пример с цветами просто для наглядности. Интересны именно новые методы, отличные от описанных в шапке  :)
Цитата
Дмитрий Щербаков написал:
как код должен определить где какой диапазон
считаем, что мы передали в макрос rngBig и rngSmall и они усечены до UsedRange листа
Изменено: Jack Famous - 20 Мар 2018 17:34:35
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Функция 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  :idea:
Как проверю - отпишусь!
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
Цитата
Jack Famous написал:
особенно крутая находка
Все эти "находки" - от нежелания набирать лишние символы. По этой же причине системщик Деннис Ритчи в свое время придумал язык C и ОС Unix :)  
Владимир
 
Привет!Option Explicit
Код
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
Изменено: Inexsu - 20 Мар 2018 22:14:02
 
sokol92, лень — двигатель прогресса  :D Именно по этой причине в своей настройке я создал модули со "служебными" макросами и функциями (это как Union2 у вас), которые я вызываю во всех других  :)

Inexsu, спасибо за пример с автофильтром (необычно)  :idea: , только эта цветная пустая табличка просто для визуализации диапазонов. Мой косяк, поправил шапку  :)
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
Страницы: 1
Читают тему (гостей: 1)