解析网格线数据并与其他数据进行比较以获得网格范围(Parsing gridline data and comparing with other data to get grid ranges)

我有一个非常具有挑战性的问题。 解决这个问题对我来说非常重要,这样我们的部门才能节省数百万美元(所以我非常感谢真诚的帮助)。 实际上,我们在文本形式中有两个不同的“网格线数据”列。 例如GL 23.5-24 / G.这里23.5-24表示沿X轴的读数,而G表示沿Y轴的研磨。 所有这些数据都在一列中。 有时数据不是单个值而是值的组合,例如GL 24-24.7 / ST,GL 25.3-25.5 / ST,有时它类似于GL 27 / H; 27 / H.5; 26.5 / J.5和GL26 .5-27.5 / L。 现在,我在使用这些数据时面临两大挑战。 首先,我必须将这种基于文本的数据转换为某种有用且可直接理解的网格线数据,即GL 24-24.7 / ST应该在一个单元格中为24 - 24.7,而在另一个单元格中则为S - T 24-24.7沿X轴,反之亦然。 在我这样做之后,我必须将这些数据与具有相同类型数据的另一列进行比较,即GL 24.5 / S.5。 比较应该以一种方式告诉我,比较网格是否属于主网格的(作为子集)。 例如,如果我的主网格线为23 - 25 / R - T并且我的第二个网格是24.5 / S,那么第二个网格肯定会落在第一个网格之下(或之间)。

因此,总体问题是在将有用网格中的文本数据分开后检查其他网格线。 我做了一些临时工作只是为了解析整个字符串,但无法形成合理的算法来进一步继续。

这是我当前解析数据的代码。

Dim strAll() As String Dim strSNO() As String, Meesam() As String Dim lastRow As Integer, i As Integer, newRng As Range, cnt As Integer, x As String Dim a As Integer With ThisWorkbook.Sheets("Data") lastRow = .Range("A7000").End(xlUp).Row ReDim strAll(lastRow) Set newRng = .Range("A1:A" & lastRow) End With For cnt = LBound(strAll()) To UBound(strAll()) strAll(cnt) = newRng.Cells(cnt + 1, 1).Value Next Do While i < UBound(strAll) If (InStr(1, strAll(i), "Element", vbTextCompare) > 0) Then i = i + 2 Do Until InStr(1, strAll(50), "+GL", vbTextCompare) > 0 'Loop until line includes "+" Meesam = SplitMultiDelims(strAll(i), "/") a = 0 For a = LBound(Meesam) To UBound(Meesam) newRng.Offset(i, a) = Meesam(a) Next i = i + 1 Loop End If i = i + 1 Loop

I got one really challenging problem here. It is very important for me to solve this problem in order for our department to save millions (so sincere help is deeply appreciated). Actually we have two different columns of "grid-line data" in text form. e.g. GL 23.5-24 / G. Here 23.5 - 24 represents the reading along X-axis while G represents the grind along Y-axis. All this data is in one column. Sometimes the data is not single value rather a combination of values e.g. GL 24-24.7 / S-T, GL 25.3-25.5 / S-T, and at sometimes it's like GL 27/H;27/H.5;26.5/J.5 and GL26.5-27.5/L. Now I got two big challenges in working with this data. First is that I have to convert this text-based data in to some sort of useful and directly understandable grid-line data i.e. GL 24-24.7 / S-T should be like 24 - 24.7 in one cell and S - T in other with clear indication that 24 - 24.7 is along X-axis and vice versa. After I do this then I have to COMPARE this data with another column having same type of data i.e. GL 24.5 / S.5. Comparison should be in a way that it tells me whether or not compared grids fall UNDER (as a subset) of main grid or not. e.g. If i have main grid-line as 23 - 25 / R - T and I have the second grid is 24.5 / S then surely this second grid falls UNDER (or in between) the first one.

So the overall problem is about checking first grid line in other after separating the text data in useful grids. I did bit of scratch work only to get the parsing of overall strings but unable to form reasonable algorithm to proceed further.

Here is my current code to parse data.

Dim strAll() As String Dim strSNO() As String, Meesam() As String Dim lastRow As Integer, i As Integer, newRng As Range, cnt As Integer, x As String Dim a As Integer With ThisWorkbook.Sheets("Data") lastRow = .Range("A7000").End(xlUp).Row ReDim strAll(lastRow) Set newRng = .Range("A1:A" & lastRow) End With For cnt = LBound(strAll()) To UBound(strAll()) strAll(cnt) = newRng.Cells(cnt + 1, 1).Value Next Do While i < UBound(strAll) If (InStr(1, strAll(i), "Element", vbTextCompare) > 0) Then i = i + 2 Do Until InStr(1, strAll(50), "+GL", vbTextCompare) > 0 'Loop until line includes "+" Meesam = SplitMultiDelims(strAll(i), "/") a = 0 For a = LBound(Meesam) To UBound(Meesam) newRng.Offset(i, a) = Meesam(a) Next i = i + 1 Loop End If i = i + 1 Loop

最满意答案

Function IsInside(Area As String, Rectangle As String) As Boolean Dim Parts() As String Dim Line1 As String, Line2 As String, Lx1 As Single, Ly1 As Single, Lx2 As String, Ly2 As String Dim Rect1 As String, Rect2 As String, Rx1 As Single, Ry1 As Single, Rx2 As String, Ry2 As String On Error Resume Next Parts = Split(Replace(Area, " ", ""), "/") Line1 = Parts(0) Line2 = Parts(1) If InStr(1, Line1, "-", vbTextCompare) > 0 Then Parts = Split(Line1, "-") Lx1 = Parts(0) Ly1 = Parts(1) Else Lx1 = Line1 Ly1 = "0" End If If InStr(1, Line2, "-", vbTextCompare) > 0 Then Parts = Split(Line2, "-") Lx2 = Parts(0) Ly2 = Parts(1) Else Lx2 = Line2 Ly2 = 0 End If Parts = Split(Replace(Rectangle, " ", ""), "/") Rect1 = Parts(0) Rect2 = Parts(1) If InStr(1, Rect1, "-", vbTextCompare) > 0 Then Parts = Split(Rect1, "-") Rx1 = Parts(0) Ry1 = Parts(1) Else Rx1 = Rect1 Ry1 = 0 End If If InStr(1, Rect2, "-", vbTextCompare) > 0 Then Parts = Split(Rect2, "-") Rx2 = Parts(0) Ry2 = Parts(1) Else Rx2 = Rect2 Ry2 = 0 End If If Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 Else End If End Function

因此,您所要做的就是将网格值放在一个单元格中,将更大的矩形值(您必须在其中搜索)放在另一个单元格中,并使用上面提到的函数。

Function IsInside(Area As String, Rectangle As String) As Boolean Dim Parts() As String Dim Line1 As String, Line2 As String, Lx1 As Single, Ly1 As Single, Lx2 As String, Ly2 As String Dim Rect1 As String, Rect2 As String, Rx1 As Single, Ry1 As Single, Rx2 As String, Ry2 As String On Error Resume Next Parts = Split(Replace(Area, " ", ""), "/") Line1 = Parts(0) Line2 = Parts(1) If InStr(1, Line1, "-", vbTextCompare) > 0 Then Parts = Split(Line1, "-") Lx1 = Parts(0) Ly1 = Parts(1) Else Lx1 = Line1 Ly1 = "0" End If If InStr(1, Line2, "-", vbTextCompare) > 0 Then Parts = Split(Line2, "-") Lx2 = Parts(0) Ly2 = Parts(1) Else Lx2 = Line2 Ly2 = 0 End If Parts = Split(Replace(Rectangle, " ", ""), "/") Rect1 = Parts(0) Rect2 = Parts(1) If InStr(1, Rect1, "-", vbTextCompare) > 0 Then Parts = Split(Rect1, "-") Rx1 = Parts(0) Ry1 = Parts(1) Else Rx1 = Rect1 Ry1 = 0 End If If InStr(1, Rect2, "-", vbTextCompare) > 0 Then Parts = Split(Rect2, "-") Rx2 = Parts(0) Ry2 = Parts(1) Else Rx2 = Rect2 Ry2 = 0 End If If Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 Else End If End Function

So all you have to do is put the grid value in one cell and the value of bigger rectangle (in which you have to search) in another cell and use the above mentioned function.

解析网格线数据并与其他数据进行比较以获得网格范围(Parsing gridline data and comparing with other data to get grid ranges)

我有一个非常具有挑战性的问题。 解决这个问题对我来说非常重要,这样我们的部门才能节省数百万美元(所以我非常感谢真诚的帮助)。 实际上,我们在文本形式中有两个不同的“网格线数据”列。 例如GL 23.5-24 / G.这里23.5-24表示沿X轴的读数,而G表示沿Y轴的研磨。 所有这些数据都在一列中。 有时数据不是单个值而是值的组合,例如GL 24-24.7 / ST,GL 25.3-25.5 / ST,有时它类似于GL 27 / H; 27 / H.5; 26.5 / J.5和GL26 .5-27.5 / L。 现在,我在使用这些数据时面临两大挑战。 首先,我必须将这种基于文本的数据转换为某种有用且可直接理解的网格线数据,即GL 24-24.7 / ST应该在一个单元格中为24 - 24.7,而在另一个单元格中则为S - T 24-24.7沿X轴,反之亦然。 在我这样做之后,我必须将这些数据与具有相同类型数据的另一列进行比较,即GL 24.5 / S.5。 比较应该以一种方式告诉我,比较网格是否属于主网格的(作为子集)。 例如,如果我的主网格线为23 - 25 / R - T并且我的第二个网格是24.5 / S,那么第二个网格肯定会落在第一个网格之下(或之间)。

因此,总体问题是在将有用网格中的文本数据分开后检查其他网格线。 我做了一些临时工作只是为了解析整个字符串,但无法形成合理的算法来进一步继续。

这是我当前解析数据的代码。

Dim strAll() As String Dim strSNO() As String, Meesam() As String Dim lastRow As Integer, i As Integer, newRng As Range, cnt As Integer, x As String Dim a As Integer With ThisWorkbook.Sheets("Data") lastRow = .Range("A7000").End(xlUp).Row ReDim strAll(lastRow) Set newRng = .Range("A1:A" & lastRow) End With For cnt = LBound(strAll()) To UBound(strAll()) strAll(cnt) = newRng.Cells(cnt + 1, 1).Value Next Do While i < UBound(strAll) If (InStr(1, strAll(i), "Element", vbTextCompare) > 0) Then i = i + 2 Do Until InStr(1, strAll(50), "+GL", vbTextCompare) > 0 'Loop until line includes "+" Meesam = SplitMultiDelims(strAll(i), "/") a = 0 For a = LBound(Meesam) To UBound(Meesam) newRng.Offset(i, a) = Meesam(a) Next i = i + 1 Loop End If i = i + 1 Loop

I got one really challenging problem here. It is very important for me to solve this problem in order for our department to save millions (so sincere help is deeply appreciated). Actually we have two different columns of "grid-line data" in text form. e.g. GL 23.5-24 / G. Here 23.5 - 24 represents the reading along X-axis while G represents the grind along Y-axis. All this data is in one column. Sometimes the data is not single value rather a combination of values e.g. GL 24-24.7 / S-T, GL 25.3-25.5 / S-T, and at sometimes it's like GL 27/H;27/H.5;26.5/J.5 and GL26.5-27.5/L. Now I got two big challenges in working with this data. First is that I have to convert this text-based data in to some sort of useful and directly understandable grid-line data i.e. GL 24-24.7 / S-T should be like 24 - 24.7 in one cell and S - T in other with clear indication that 24 - 24.7 is along X-axis and vice versa. After I do this then I have to COMPARE this data with another column having same type of data i.e. GL 24.5 / S.5. Comparison should be in a way that it tells me whether or not compared grids fall UNDER (as a subset) of main grid or not. e.g. If i have main grid-line as 23 - 25 / R - T and I have the second grid is 24.5 / S then surely this second grid falls UNDER (or in between) the first one.

So the overall problem is about checking first grid line in other after separating the text data in useful grids. I did bit of scratch work only to get the parsing of overall strings but unable to form reasonable algorithm to proceed further.

Here is my current code to parse data.

Dim strAll() As String Dim strSNO() As String, Meesam() As String Dim lastRow As Integer, i As Integer, newRng As Range, cnt As Integer, x As String Dim a As Integer With ThisWorkbook.Sheets("Data") lastRow = .Range("A7000").End(xlUp).Row ReDim strAll(lastRow) Set newRng = .Range("A1:A" & lastRow) End With For cnt = LBound(strAll()) To UBound(strAll()) strAll(cnt) = newRng.Cells(cnt + 1, 1).Value Next Do While i < UBound(strAll) If (InStr(1, strAll(i), "Element", vbTextCompare) > 0) Then i = i + 2 Do Until InStr(1, strAll(50), "+GL", vbTextCompare) > 0 'Loop until line includes "+" Meesam = SplitMultiDelims(strAll(i), "/") a = 0 For a = LBound(Meesam) To UBound(Meesam) newRng.Offset(i, a) = Meesam(a) Next i = i + 1 Loop End If i = i + 1 Loop

最满意答案

Function IsInside(Area As String, Rectangle As String) As Boolean Dim Parts() As String Dim Line1 As String, Line2 As String, Lx1 As Single, Ly1 As Single, Lx2 As String, Ly2 As String Dim Rect1 As String, Rect2 As String, Rx1 As Single, Ry1 As Single, Rx2 As String, Ry2 As String On Error Resume Next Parts = Split(Replace(Area, " ", ""), "/") Line1 = Parts(0) Line2 = Parts(1) If InStr(1, Line1, "-", vbTextCompare) > 0 Then Parts = Split(Line1, "-") Lx1 = Parts(0) Ly1 = Parts(1) Else Lx1 = Line1 Ly1 = "0" End If If InStr(1, Line2, "-", vbTextCompare) > 0 Then Parts = Split(Line2, "-") Lx2 = Parts(0) Ly2 = Parts(1) Else Lx2 = Line2 Ly2 = 0 End If Parts = Split(Replace(Rectangle, " ", ""), "/") Rect1 = Parts(0) Rect2 = Parts(1) If InStr(1, Rect1, "-", vbTextCompare) > 0 Then Parts = Split(Rect1, "-") Rx1 = Parts(0) Ry1 = Parts(1) Else Rx1 = Rect1 Ry1 = 0 End If If InStr(1, Rect2, "-", vbTextCompare) > 0 Then Parts = Split(Rect2, "-") Rx2 = Parts(0) Ry2 = Parts(1) Else Rx2 = Rect2 Ry2 = 0 End If If Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 Else End If End Function

因此,您所要做的就是将网格值放在一个单元格中,将更大的矩形值(您必须在其中搜索)放在另一个单元格中,并使用上面提到的函数。

Function IsInside(Area As String, Rectangle As String) As Boolean Dim Parts() As String Dim Line1 As String, Line2 As String, Lx1 As Single, Ly1 As Single, Lx2 As String, Ly2 As String Dim Rect1 As String, Rect2 As String, Rx1 As Single, Ry1 As Single, Rx2 As String, Ry2 As String On Error Resume Next Parts = Split(Replace(Area, " ", ""), "/") Line1 = Parts(0) Line2 = Parts(1) If InStr(1, Line1, "-", vbTextCompare) > 0 Then Parts = Split(Line1, "-") Lx1 = Parts(0) Ly1 = Parts(1) Else Lx1 = Line1 Ly1 = "0" End If If InStr(1, Line2, "-", vbTextCompare) > 0 Then Parts = Split(Line2, "-") Lx2 = Parts(0) Ly2 = Parts(1) Else Lx2 = Line2 Ly2 = 0 End If Parts = Split(Replace(Rectangle, " ", ""), "/") Rect1 = Parts(0) Rect2 = Parts(1) If InStr(1, Rect1, "-", vbTextCompare) > 0 Then Parts = Split(Rect1, "-") Rx1 = Parts(0) Ry1 = Parts(1) Else Rx1 = Rect1 Ry1 = 0 End If If InStr(1, Rect2, "-", vbTextCompare) > 0 Then Parts = Split(Rect2, "-") Rx2 = Parts(0) Ry2 = Parts(1) Else Rx2 = Rect2 Ry2 = 0 End If If Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 >= Rx1 And Lx1 <= Ry1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Ly2 <= Ry2 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 > 0 Then IsInside = Lx1 = Rx1 And Lx2 >= Rx2 And Lx2 <= Ry2 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 = 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 > 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 > 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 ElseIf Lx1 > 0 And Ly1 = 0 And Lx2 > 0 And Ly2 = 0 And Rx1 > 0 And Ry1 > 0 And Rx2 > 0 And Ry2 = 0 Then IsInside = 0 Else End If End Function

So all you have to do is put the grid value in one cell and the value of bigger rectangle (in which you have to search) in another cell and use the above mentioned function.