Ask Your Question
0

How to test if a cell is in a given range in a macro ?

asked 2017-09-11 12:25:34 +0200

dleducq gravatar image

Does there exist an API function to test whether a Cell object is contained in a given CellRange object ?

edit retag flag offensive close merge delete

2 Answers

Sort by » oldest newest most voted
0

answered 2017-09-11 13:32:10 +0200

JohnSUN gravatar image

I hope that parsing this example will help you understand how to use queryIntersection.

Sub demoQueryIntersection
Dim oSheet As Variant
Dim oCellRange As Variant
Dim oCells As Variant
Dim oRes As Variant
  oSheet = ThisComponent.getSheets().getByIndex(0)
  oCellRange = oSheet.getCellRangeByName("B5:F20")

  oCells = oSheet.getCellByPosition(0, 0)
  oRes = oCells.queryIntersection(oCellRange.getRangeAddress())
  If oRes.getCount() then
    MsgBox("Range '" + oCellRange.AbsoluteName + "'" + Chr(10) + _
        "intersected with '" + oCells.AbsoluteName + "'" + Chr(10) + _
        "in '" + oRes.AbsoluteName +"'", 64, "Result of test")
  Else
    MsgBox("Range '" + oCellRange.AbsoluteName + "'" + Chr(10) + _
        "have not intersect with '" + oCells.AbsoluteName + "'", 64, "Result of test")
  EndIf 

  oCells = oSheet.getCellByPosition(3, 8)
  oRes = oCells.queryIntersection(oCellRange.getRangeAddress())
  If oRes.getCount() then
    MsgBox("Range '" + oCellRange.AbsoluteName + "'" + Chr(10) + _
        "intersected with '" + oCells.AbsoluteName + "'" + Chr(10) + _
        "in '" + oRes.AbsoluteName +"'", 64, "Result of test")
  Else
    MsgBox("Range '" + oCellRange.AbsoluteName + "'" + Chr(10) + _
        "have not intersect with '" + oCells.AbsoluteName + "'", 64, "Result of test")
  EndIf 

  oCells = oSheet.getCellRangeByName("E18:M24")
  oRes = oCells.queryIntersection(oCellRange.getRangeAddress())
  If oRes.getCount() then
    MsgBox("Range '" + oCellRange.AbsoluteName + "'" + Chr(10) + _
        "intersected with '" + oCells.AbsoluteName + "'" + Chr(10) + _
        "in '" + oRes.AbsoluteName +"'", 64, "Result of test")
  Else
    MsgBox("Range '" + oCellRange.AbsoluteName + "'" + Chr(10) + _
        "have not intersect with '" + oCells.AbsoluteName + "'", 64, "Result of test")
  EndIf 
End Sub
edit flag offensive delete link more

Comments

That does the job, thanks

dleducq gravatar imagedleducq ( 2017-09-11 18:27:58 +0200 )edit
0

answered 2017-09-11 13:33:02 +0200

librebel gravatar image

updated 2017-09-11 15:05:35 +0200

Hello @dleducq,

theCellRange object has a method getCellByPosition( nColumnIndex, nRowIndex ), it yields an IndexOutOfBoundsException if the specified position is outside of the range.

EDIT 15:05

Alternatively you could just compare the addresses:

Function rangeContains( sRange As String, sCell As String ) As Boolean
    On Local Error Resume Next
    Dim oSheet As Object, oRange As Object, oCell as Object
    oSheet = ThisComponent.CurrentController.ActiveSheet
    oRange = oSheet.getCellRangebyName( sRange ).getRangeAddress()
    oCell  = oSheet.getCellRangebyName( sCell ).getRangeAddress()
    rangeContains = oCell.StartColumn >= oRange.StartColumn And oCell.StartColumn <= oRange.EndColumn _
    And oCell.EndColumn >= oRange.StartColumn   And oCell.EndColumn <= oRange.EndColumn _
    And oCell.StartRow >= oRange.StartRow       And oCell.StartRow <= oRange.EndRow _
    And oCell.EndRow >= oRange.StartRow         And oCell.EndRow <= oRange.EndRow
End Function

=RANGECONTAINS("C3:D6";"C4")

=RANGECONTAINS("C3:D6";"C4:C6")

edit flag offensive delete link more

Comments

Thanks librebel, Are all the tests indeed necessary ? I'd think that

oCell.StartColumn >= oRange.StartColumn And oCell.EndColumn <= oRange.EndColumn _
And oCell.StartRow >= oRange.StartRow And oCell.EndRow <= oRange.EndRow

would be enough...

dleducq gravatar imagedleducq ( 2017-09-11 18:34:32 +0200 )edit

Yeah for a single cell it would be enough, but this way it also works for ranges within the range.

librebel gravatar imagelibrebel ( 2017-09-11 19:08:37 +0200 )edit
Login/Signup to Answer

Question Tools

1 follower

Stats

Asked: 2017-09-11 12:25:34 +0200

Seen: 197 times

Last updated: Sep 11 '17