VBA тест, если ячейка находится в диапазоне - PullRequest
12 голосов
/ 03 марта 2011

Я хочу проверить, находится ли данная ячейка в заданном диапазоне в Excel VBA.Каков наилучший способ сделать это?

Ответы [ 6 ]

27 голосов
/ 03 марта 2011

Из справки:

Set isect = Application.Intersect(Range("rg1"), Range("rg2"))
If isect Is Nothing Then
    MsgBox "Ranges do not intersect"
Else
    isect.Select
End If
12 голосов
/ 08 января 2015

Если два тестируемых диапазона (ваша заданная ячейка и ваш заданный диапазон ) не совпадают с Worksheet, то Application.Intersect выдает ошибку . Таким образом, способ избежать этого - это что-то вроде

Sub test_inters(rng1 As Range, rng2 As Range)
    If (rng1.Parent.Name = rng2.Parent.Name) Then
        Dim ints As Range
        Set ints = Application.Intersect(rng1, rng2)
        If (Not (ints Is Nothing)) Then
            ' Do your job
        End If
    End If
End Sub
9 голосов
/ 03 марта 2011

Определите, находится ли ячейка в диапазоне, используя VBA в Microsoft Excel :

С сайта, на который ведут ссылки (сохранение кредита для первоначального отправителя):

Макросовик VBA предоставлен Erlandsen Data Consulting разработка приложений Microsoft Excel, настройка шаблонов, поддержка и обучение решения

Function InRange(Range1 As Range, Range2 As Range) As Boolean
    ' returns True if Range1 is within Range2
    InRange = Not (Application.Intersect(Range1, Range2) Is Nothing)
End Function


Sub TestInRange()
    If InRange(ActiveCell, Range("A1:D100")) Then
        ' code to handle that the active cell is within the right range
        MsgBox "Active Cell In Range!"
    Else
        ' code to handle that the active cell is not within the right range
        MsgBox "Active Cell NOT In Range!"
    End If
End Sub
0 голосов
/ 29 мая 2018

Я не работаю со смежными диапазонами все время. Мое решение для несмежных диапазонов следующее (включает в себя некоторый код из других ответов здесь):

Sub test_inters()
    Dim rng1 As Range
    Dim rng2 As Range
    Dim inters As Range

    Set rng2 = Worksheets("Gen2").Range("K7")
    Set rng1 = ExcludeCell(Worksheets("Gen2").Range("K6:K8"), rng2)

    If (rng2.Parent.name = rng1.Parent.name) Then
        Dim ints As Range
        MsgBox rng1.Address & vbCrLf _
        & rng2.Address & vbCrLf _

        For Each cell In rng1
            MsgBox cell.Address
            Set ints = Application.Intersect(cell, rng2)
            If (Not (ints Is Nothing)) Then
                MsgBox "Yes intersection"
            Else
                MsgBox "No intersection"
            End If
        Next cell
    End If
End Sub
0 голосов
/ 29 ноября 2017

Вот еще один вариант, чтобы увидеть, существует ли ячейка внутри диапазона.Если у вас есть проблемы с решением Intersect, как я.

If InStr(range("NamedRange").Address, range("IndividualCell").Address) > 0 Then
    'The individual cell exists in the named range
Else
    'The individual cell does not exist in the named range
End If

InStr - это функция VBA, которая проверяет, существует ли строка в другой строке.

https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/instr-function

0 голосов
/ 08 декабря 2015

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

Sub DynamicRange()

Dim sht As Worksheet
Dim LastRow As Long
Dim StartCell As Range
Dim rng As Range

Set sht = Worksheets("xyz")
LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
Set rng = Workbooks("Record.xlsm").Worksheets("xyz").Range(Cells(12, 2), Cells(LastRow, 12))

Debug.Print LastRow

If InRange(ActiveCell, rng) Then
'        MsgBox "Active Cell In Range!"
  Else
      MsgBox "Please select the cell within the range!"
  End If

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