Главная Вход в систему Регистрация
Задать вопрос Консультации Пользователи Форум
О системе Помощь
Задать вопрос экспертам
Консультация № 201086
04.06.2021, 19:49
0.00 руб.
05.06.2021, 15:34
0 4 1
Компьютеры Программное обеспечение
Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:
Подсчитать сколько точек плоскости, координаты которых вводятся с первых двух столбцов рабочего листа, находятся вне квадрата 0<=x<=1 и 0<=y<=1. Для описания координат точек использовать переменную пользовательского типа. Для проверки принадлежности точки указанной области использовать логическую функцию.
(На языке VBA)
Огромное спасибо!!!

Обсуждение

давно
Megaloman
Модератор
137394
1850
05.06.2021, 11:21
общий
Адресаты:
Уточните, пожалуйста, что подразумевается под
0?x?1 и 0?y?1.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
давно
23071996
Посетитель
404319
21
05.06.2021, 11:23
общий
0<=x<=1 и 0<=y<=1. Извините скопировал и не посмотрел даже как написал.
давно
Megaloman
Модератор
137394
1850
05.06.2021, 15:33
общий
05.06.2021, 16:16
это ответ
Код:
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
Прикрепленные файлы:
5
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
давно
Megaloman
Модератор
137394
1850
05.06.2021, 22:24
общий
Слегка изменил код, чтобы все координаты описывались переменными пользовательского типа
Код:
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
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Форма ответа