Type Koord
x As Double
y As Double
End Type
Sub rrr()
' Const R1 = "A1"
Const R1 = "C5"
Const x1 = 0, x2 = 1
Const y1 = 0, y2 = 1
R2 = Range(R1).End(xlDown).Offset(0, 1).Address
N = Range(R2).Row - Range(R1).Row + 1
If Len(Trim(CStr(Range(R1)))) = 0 Or Len(Trim(CStr(Range(R2)))) = 0 Then
MsgBox "В ячейке " + R1 + " или " + R2 + " нет координат"
Exit Sub
End If
ReDim Points(1 To N) As Koord
For i = 1 To N
Points(i).x = Range(R1).Offset(i - 1, 0)
Points(i).y = Range(R1).Offset(i - 1, 1)
Next
M = 0
For i = 1 To N
If Square(Points(i), x1, x2, y1, y2) Then M = M + 1
Next
MsgBox "Число точек с координатами:" + vbCrLf + vbCrLf + "0<=x<=1 0<=y<=1" + vbCrLf + vbCrLf + "равно " + CStr(M)
End Sub
Function Square(P As Koord, x1, x2, y1, y2)
Square = (x1 <= P.x And P.x <= x2 And y1 <= P.y And P.y <= y2)
End Function
Type Koord
x As Double
y As Double
End Type
Sub rrr()
' Const R1 = "A1"
Const R1 = "C5"' Const x1 = 0, x2 = 1
' Const y1 = 0, y2 = 1
Dim xy1 As Koord, xy2 As Koord
xy1.x = 0
xy1.y = 0
xy2.x = 1
xy2.y = 1
R2 = Range(R1).End(xlDown).Offset(0, 1).Address
N = Range(R2).Row - Range(R1).Row + 1
If Len(Trim(CStr(Range(R1)))) = 0 Or Len(Trim(CStr(Range(R2)))) = 0 Then
MsgBox "В ячейке " + R1 + " или " + R2 + " нет координат"
Exit Sub
End If
ReDim Points(1 To N) As Koord
For i = 1 To N
Points(i).x = Range(R1).Offset(i - 1, 0)
Points(i).y = Range(R1).Offset(i - 1, 1)
Next
M = 0
For i = 1 To N
If Square(Points(i), xy1, xy2) Then M = M + 1
Next
MsgBox "Число точек с координатами:" + vbCrLf + vbCrLf + _
CStr(xy1.x) + "<=x<=" + CStr(xy2.x) + " " + CStr(xy1.y) + "<=y<=" + CStr(xy2.y) + _
vbCrLf + vbCrLf + "равно " + CStr(M)
End Sub
Function Square(P As Koord, q1 As Koord, q2 As Koord)
Square = (q1.x <= P.x And P.x <= q2.x And q1.y <= P.y And P.y <= q2.y)
End Function
Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.