Исключить несколько ячеек из диапазона - PullRequest
2 голосов
/ 20 февраля 2020

Мой вопрос: как я могу удалить ячейку или ячейки из объекта диапазона? Я задал нечто очень похожее ранее, и некоторые люди указали мне на этот вопрос: Удалить ячейку из диапазона (объекта)

Принятый ответ:

Function getExcluded(ByVal rngMain As Range, rngExc As Range) As Range
    Dim rngTemp     As Range
    Dim rng         As Range

    Set rngTemp = rngMain
    Set rngMain = Nothing

    For Each rng In rngTemp
        If rng.Address <> rngExc.Address Then
            If rngMain Is Nothing Then
                Set rngMain = rng
            Else
                Set rngMain = Union(rngMain, rng)
            End If
        End If
    Next

    Set getExcluded = rngMain
End Function


Sub test()
    MsgBox getExcluded(Range("A1:M10000"), Range("a10")).Address
End Sub

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

Моя попытка:

Function getExcluded(ByVal rngMain As Range, rngExcl As Range) As Range
    Dim rngTemp As Range
    Dim cellTemp As Range, cellExcl As Range

    Set rngTemp = rngMain
    Set rngMain = Nothing

    For Each cellTemp In rngTemp 'go through all cells in established range
        If Intersect(cellTemp, rngExcl) Is Nothing Then 'check for each cell if it intersects with the range to be excluded; no overlap -> put it into rngMain
            If rngMain Is Nothing Then
                Set rngMain = cellTemp
            Else
                rngMain = Union(rngMain, cellTemp)
            End If

            Debug.Print "cellTemp: " & cellTemp.Address
            Debug.Print "rngMain: " & rngMain.Address

        End If
    Next cellTemp

    Set getExcluded = rngMain


Sub test5()

    getExcluded(Range("A1:D3"), Range("B1:C1")).Select
End Sub

Кажется, проблема возникает в линия Set rngMain = Union(rngMain, rng). Мои утверждения Debug.Print говорят мне, что cellTemp проходит через все так, как и должно; однако, даже если строка с Union выполняется и независимо от того, что является cellTemp, rngMain остается $A$1

Что я делаю неправильно?

Ответы [ 2 ]

2 голосов
/ 20 февраля 2020

Опираясь на @ Nathan_Sav.

Это позволит добавить множество исключаемых диапазонов:

Function testexclude(rngMain As Range, ParamArray rngExclude() As Variant) As Range


Dim i As Long
For i = LBound(rngExclude, 1) To UBound(rngExclude, 1)
    Dim rngexcluderng As Range
    If rngexcluderng Is Nothing Then
        Set rngexcluderng = rngExclude(i)
    Else
        Set rngexcluderng = Union(rngexcluderng, rngExclude(i))
    End If
Next i


Dim c As Range
For Each c In rngMain

    If Intersect(c, rngexcluderng) Is Nothing Then
        Dim r As Range
        If r Is Nothing Then
            Set r = c
        Else
            Set r = Union(r, c)
        End If
    End If

Next c

Set testexclude = r

End Function
2 голосов
/ 20 февраля 2020

Примерно так же, настройка диапазона объединения также

Function testexclude(rngMain As Excel.Range, rngExclude As Excel.Range) As Excel.Range

Dim c As Excel.Range
Dim r As Excel.Range

For Each c In rngMain

    If Intersect(c, rngExclude) Is Nothing Then
        If r Is Nothing Then
            Set r = c
        Else
            Set r = Union(r, c)
        End If
    End If

Next c

Set testexclude = r

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...