Question

我想确定rngA是否处于像rngB这样的封闭范围内。

UNION和INTERSECT功能不会起作用。

Sub InnerRange()

Dim rngA As Range
Dim rngB As Range

Dim i As Range

Set rngA = Range("H6")
Set rngB = Range("E4:J4,J5:J8,E8:I8,E5:E7")

Union(rngA, rngB).Select

End Sub

Answer 1

这应该能够处理A和B的连续和非连续范围。将rngA和rngB传递给IsIn。如果rngA中包含rngB，则会返回true：

Option Explicit

Dim lngRowMin As Long
Dim lngRowMax As Long
Dim lngColMin As Long
Dim lngColMax As Long
Dim blnMap() As Boolean

Public Function IsIn(rngInner As Range, rngOuter As Range) As Boolean
    If (rngInner.Rows.Count > rngOuter.Rows.Count) Or (rngInner.Columns.Count > rngOuter.Columns.Count) Or (rngInner.Row < rngOuter.Row) Then
        Exit Function
    End If

    Dim cel As Range
    Dim lngInnerCoord As Long
    Dim lngOuterCoord As Long
    Dim lngCoord As Long
    Dim lngOuterCoords() As Long
    Dim lngInnerCoords() As Long

    ReDim lngOuterCoords(1 To rngOuter.Count, 1 To 2)
    ReDim lngInnerCoords(1 To rngInner.Count, 1 To 2)
    lngRowMin = rngOuter.Row
    lngRowMax = lngRowMin
    lngColMin = rngOuter.Column
    lngColMax = lngColMin

    For Each cel In rngOuter
        lngOuterCoord = lngOuterCoord + 1
        lngOuterCoords(lngOuterCoord, 1) = cel.Row
        lngOuterCoords(lngOuterCoord, 2) = cel.Column

        If lngOuterCoords(lngOuterCoord, 1) > lngRowMax Then
            lngRowMax = lngOuterCoords(lngOuterCoord, 1)
        ElseIf lngOuterCoords(lngOuterCoord, 1) < lngRowMin Then
            lngRowMin = lngOuterCoords(lngOuterCoord, 1)
        End If

        If lngOuterCoords(lngOuterCoord, 2) > lngColMax Then
            lngColMax = cel.Column
        ElseIf lngOuterCoords(lngOuterCoord, 2) < lngColMin Then
            lngColMin = lngOuterCoords(lngOuterCoord, 2)
        End If
    Next cel

    For Each cel In rngInner
        lngInnerCoord = lngInnerCoord + 1
        lngInnerCoords(lngInnerCoord, 1) = cel.Row
        lngInnerCoords(lngInnerCoord, 2) = cel.Column

        If lngInnerCoords(lngInnerCoord, 1) > lngRowMax Then
            Exit Function
        ElseIf lngInnerCoords(lngInnerCoord, 1) < lngRowMin Then
            Exit Function
        End If

        If lngInnerCoords(lngInnerCoord, 2) > lngColMax Then
            Exit Function
        ElseIf lngInnerCoords(lngInnerCoord, 2) < lngColMin Then
            Exit Function
        End If
    Next cel

    ReDim blnMap(lngRowMin To lngRowMax, lngColMin To lngColMax)

    For lngCoord = 1 To lngOuterCoord
        blnMap(lngOuterCoords(lngCoord, 1), lngOuterCoords(lngCoord, 2)) = True
    Next lngCoord

    For lngCoord = 1 To lngInnerCoord
        If Not InnerTrap(lngInnerCoords(lngCoord, 1), lngInnerCoords(lngCoord, 2)) Then Exit Function
    Next lngCoord

    IsIn = True
End Function

Private Function InnerTrap(lngRow As Long, lngCol As Long) As Boolean
    On Error GoTo Escaped

    If Not blnMap(lngRow, lngCol) Then
        blnMap(lngRow, lngCol) = True
        If Not InnerTrap(lngRow + 1, lngCol) Then Exit Function
        If Not InnerTrap(lngRow - 1, lngCol) Then Exit Function
        If Not InnerTrap(lngRow, lngCol + 1) Then Exit Function
        If Not InnerTrap(lngRow, lngCol - 1) Then Exit Function
    End If

    InnerTrap = True
Escaped:

End Function

Answer 2

这将适用于连续范围：

Sub FindInnerRange()

    Dim rngA As Range, rngB As Range

    Set rngA = Range("H8")
    Set rngB = Range("E4:J4,J5:J8,E8:I8,E5:E7")

    MsgBox rngA.Address & " is" _
           & IIf(Not Intersect(rngA, Intersect(rngB.EntireRow, rngB.EntireColumn)) Is Nothing And Intersect(rngA, rngB) Is Nothing, "", " NOT") _
           & " in a closed range " & rngB.Address, vbCritical

End Sub

Answer 3

如果外围范围确实是封闭的，那么您可以使用CurrentRegion

Sub InnerRange()

Dim rngA As Range
Dim rngB As Range
Dim rngC As Range
Dim rngD As Range

    Dim i As Range

    Set rngA = Range("H6")
    Set rngB = Range("E4:J4,J5:J8,E8:I8,E5:E7")

    Set rngC = rngB.CurrentRegion
    Set rngD = Intersect(rngC, rngA)
    Debug.Print rngD.Address
    End Sub

Answer 4

thnx，我找到了一个解决方案以及泛洪填充算法：

Sub New()

Dim rngA As Range
Dim rngB As Range

Dim i As Range

Set rngA = Range("H6")
Set rngB = Range("E4:J4,J5:J8,E8:I8,E5:J6")


FloodFill rngA.Offset(1, 0), rngB, 1, 1

MsgBox rngA.Address & " is in closed range " & rngB.Address, vbInformation

End Sub

Sub FloodFill(rngA, rngB, x, y)

If Not rngA.Cells(x, y).Interior.Color = 12874308 And _
Not rngA.Cells(x, y).Value = "x" Then

    rngA.Cells(x, y).Value = "x"

    If byPassing(rngA.Cells(x, y), rngB) = True Then
        MsgBox rngA.Address & " is not in a closed range " & rngB.Address, vbCritical
        End
    End If

    FloodFill rngA, rngB, x, y + 1
    FloodFill rngA, rngB, x, y - 1
    FloodFill rngA, rngB, x + 1, y
    FloodFill rngA, rngB, x - 1, y

End If

End Sub

Function byPassing(rngA, rngB) As Boolean

Dim cA As Long

Dim cBmin As Long
Dim cBmax As Long

Dim rA As Long

Dim rBmin As Long
Dim rBmax As Long

'   Colums

cA = rngA.Column

cBmin = rngB.Column
cBmax = cBmin + rngB.Columns.Count - 1

If Not (cA > cBmin And cA < cBmax) Then
    byPassing = True
    Exit Function
End If

'   Rows

rA = rngA.Row

rBmin = rngB.Row
rBmax = rBmin + rngB.CurrentRegion.Rows.Count - 1

If Not (rA > rBmin And rA < rBmax) Then
    byPassing = True
    Exit Function
End If

End Function

确定范围是否在闭合范围内

4 个答案: