Как исключить ячейку Х из диапазона А

[IgorGO]

как добавить ячейку (диапазон) Х в диапазон А понятно
set A = Application.Union(A, X)

А есть простой способ как ИСКЛЮЧИТЬ ячейку Х из диапазона А.

Уважаемые программисты, нужна функция типа
Function DeLCeLL(BaseRg as range, Cel2Del as range) as range

т.е. на входе диапазон и какая-то ячейка из него, на выходе тот же диапазон, но уже без указанной ячейки (ни сама ячейка на листе, ни данные в ней не должны пострадать). Может есть стандартные средства VBA для этого?

Спасибо!

[Казанский]

Вроде кто-то из гуру делал это, и даже не для одной ячейки. Стандартных средств точно нет.
Если все же делать: можно перебрать области диапазона и проверять intersect с ячейкой. Если пересечения нет, область добавляется к выходному диапазону. Если пересечение есть, ячейка делит эту область на 4 диапазона (в общем случае): сверху, снизу, строка слева и строка справа. Или слева, справа, столбец сверху и столбец снизу - можно выбрать этот вариант, если область имеет .rows.count > .columns.count.
Координаты диапазонов вычисляются арифметически, и диапазоны добавляются к выходному диапазону.

[maksim_serg]

Sub RangeSelect()
    DelCell2(Selection, Range("a2:a14,C4")).Select
End Sub

Public Function DelCell2(BaseRg As Range, DelRg As Range) As Range
    Dim newRg As Range:
    For Each Ar In BaseRg
        If Application.Intersect(Ar, DelRg) Is Nothing Then
            If newRg Is Nothing Then
                Set newRg = Ar
            Else
                Set newRg = Union(newRg, Ar)
            End If
        End If
    Next
    Set DelCell2 = newRg
End Function

Ну ни как не хотел VBA такое имя пропускать: DeLCeLL

[Казанский]

Если диапазон небольшой, можно, конечно, и по ячейкам. Но попробуйте таким способом исключить что-нибудь из целого столбца в 2007

[maksim_serg]

Сообщение от Казанский

Если диапазон небольшой, можно, конечно, и по ячейкам. Но попробуйте таким способом исключить что-нибудь из целого столбца в 2007

как сказали в одном фильме: "Две минуты, Турецкий!"

[IgorGO]

Sub RangeSelect()
  Dim tm As Single
  tm = Timer
  DelCell2([c:c], [c3]).Select
  MsgBox Timer - tm
End Sub

maksim_serg, знаете что MsgBox показал? 61 сек.

а теперь представте так, по одной, надо удалить ячейки из всего столбика
= 61/2*1048000/60/60/24 = 369 дней.
чуть больше года работы и готово!

моя процедура делает это за 3-4 минуты это где-то в 200тыс.раз быстрее, чем 369 дней.

[SAS888]

Если из диапазона "A" требуется получить диапазон с "вырезанной" ячейкой "X", то перебирать поячеечно, это слишком долго. Предлагаю, примерно так:

Function CutCell(A As Range, X As Range) As Range
    Dim rng As Range
    If X.Row > 1 Then Set rng = Rows("1:" & X.Row - 1)
    If X.Row < Rows.Count Then If rng Is Nothing Then _
        Set rng = Rows(X.Row + 1 & ":" & Rows.Count) Else Set rng = Union(rng, Rows(X.Row + 1 & ":" & Rows.Count))
    If X.Column > 1 Then Set rng = Union(rng, Range([A1], X.Offset(, -1)).EntireColumn)
    If X.Column < Columns.Count Then Set rng = Union(rng, Range(X.Offset(, 1), Cells(X.Row, Columns.Count)).EntireColumn)
    Set CutCell = Intersect(rng, A)
End Function

[IgorGO]

спасибо, SAS888!

с пришел к этому же решению чуть корявее записанному здесь а сейчас хотел поинтересоваться не изобрел-ли я велосипед, может среди обилия встроенных функций я недосмотрел готовую.

ячейка, обозначена Я разбивает поле листа на 4 диапазона

     1-й    |
____________|  4-й
        | Я |
        |___|_______
  2-й   |
        |      3-й

могут отсутсвовать один или два диапазона, когда ячейка находится в первой (последней) строке (колонкке) листа.
эти 4-е диапазона обьединялись в один, пересечение обьединенного диапазона и исходного давало исходный без ячейки Я.

но в ситуации, когда отмечена колонка без 1 ячейки и надо инвертировать отметку и этот алгоритм работал несколько минут (3-4-5) не засекал точно, но долго - это факт.

[maksim_serg]

о, исправил (на примерно миллион строк):
DelCell2([c:c], [c3]).Select=1,92 сек
DelCell2([c:c], [c:c]).Select=3,32 сек
DelCell2([a:z], [c3]).Select=37,2 сек
DelCell2([1:1], [c1]).Select=0.18 сек
DelCell2([1:100], [c1]).Select=2,3 сек
DelCell2([a1:a1048576], [c1]).Select=1,93

[maksim_serg]

это все удалено