Анализ данных сетки и сравнение с другими данными для получения диапазонов сетки

Question

У меня есть одна очень сложная проблема. Для меня очень важно решить эту проблему, чтобы наш отдел сэкономил миллионы (поэтому искренняя помощь очень ценится). На самом деле у нас есть два разных столбца «данные сетки» в текстовой форме. например GL 23.5-24/G. Здесь 23.5-24 представляет собой показание вдоль оси X, а G представляет собой измельчение вдоль оси Y. Все эти данные находятся в одной колонке. Иногда данные не являются одиночным значением, а представляют собой комбинацию значений, например. GL 24-24.7/S-T, GL 25.3-25.5/S-T, и иногда это похоже на 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. Сравнение должно быть таким образом, чтобы оно подсказывало мне, попадают ли или нет сравниваемые решетки UNDER (как подмножество) основной сетки или нет. , например. Если у меня есть основная линия сетки как 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 

Answer 1

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 

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