Пользовательские процедуры и функции

@Gerkss · Регистрация: 06.05.2013

Студворк — интернет-сервис помощи студентам

Здравствуйте. У меня в VBA вот такая задача: найти периметр фигуры ABCD по заданным сторонам AB, АС и DC. (Определить процедуру для расчета гипотенузы прямоугольного треугольника по его катетам.)
Я сделал вот так: Public Sub q()
Dim AB As Double
Dim AC As Double
Dim DC As Double
Dim DB As Double
Dim BC As Double
Dim P As Double
AB = InputBox("введите сторону AB")
Worksheets(1).Range("G4").Value = AB
AC = InputBox("введите сторону AC")
Worksheets(1).Range("G5").Value = AC
DC = InputBox("введите сторону DC")
Worksheets(1).Range("G6").Value = DC
BC = Sqr(AB ^ 2 + AC ^ 2)
Worksheets(1).Range("G7").Value = BC
MsgBox ("Сторона BC равна = " & BC)
DB = Sqr(BC ^ 2 + DC ^ 2)
Worksheets(1).Range("G8").Value = DB
MsgBox ("Сторона DB равна = " & DB)
P = AB + AC + DC + DB
Worksheets(1).Range("G9").Value = P
MsgBox ("периметр равен = " & P)
End Sub

Считает у меня всё правильно, но препод требует, чтобы была создана под-функция с уравнением считающим гипотенузы и программа вызывала эту под-функцию дважды и высчитывала гипотенузы, с разными катетами...
Вот мой 4 угольник:

Помогите пожалуйста)

@Igor_Tr · 25.06.2013, 00:32

Функцию Вам кидаю, ее можете прикрутить к Вашему коду. Там сразу округление до 2 знака. Но саму процедуру я бы написал по другому. Кидаю, может пригодится.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub q()
Dim i&, AB#, BD#, DC#, CA#, P#, BC#, mARR()
   ReDim mARR(1 To 6, 1 To 2)
      For i = 1 To 6
         Select Case i
            Case Is = 1: mARR(i, 1) = "Кaтет AB":   mARR(i, 2) = _
                           CDbl(InputBox("введите" & Space(1) & mARR(i, 1)))
            Case Is = 2: mARR(i, 1) = "Кaтет CA":    mARR(i, 2) = _
                           CDbl(InputBox("введите" & Space(1) & mARR(i, 1)))
            Case Is = 3: mARR(i, 1) = "Кaтет DC":    mARR(i, 2) = _
                           CDbl(InputBox("введите" & Space(1) & mARR(i, 1)))
            Case Is = 4: mARR(i, 1) = "Гипот. BC":   mARR(i, 2) = _
                           mHYPOTENUSE(CDbl(mARR(1, 2)), CDbl(mARR(2, 2)))
            Case Is = 5: mARR(i, 1) = "Гипот. BD":   mARR(i, 2) = _
                           mHYPOTENUSE(CDbl(mARR(4, 2)), CDbl(mARR(3, 2)))
            Case Is = 6: mARR(i, 1) = "Периметр":    mARR(i, 2) = _
                         mARR(1, 2) + mARR(2, 2) + mARR(3, 2) + mARR(5, 2)
         End Select
      Next
      For i = 1 To 3
         MsgBox mARR(i + 3, 1) & " = " & mARR(i + 3, 2)
      Next
   ActiveSheet.Cells(2, 1).Resize(UBound(mARR, 1), UBound(mARR, 2)).Value = mARR
   Erase mARR: MsgBox Space(10) & "D O N E!"
End Sub
 
Private Function mHYPOTENUSE(a As Double, b As Double) As Double
   mHYPOTENUSE = Round(Sqr(a ^ 2 + b ^ 2), 2)
End Function

@Gerkss · 25.06.2013, 01:35 **[ТС]**

@Igor_Tr, спасибо, сообразил по вашему примеру)
И вообще большое спасибо этому форуму, если бы не вы, я бы так и остался чайником в VBA. При помощи вас я хоть не много, но начал понимать)!

@Igor_Tr · 25.06.2013, 02:13

Вот незачто... Скоро идти спать. И не дай Бог, что б мне приснилось, что я что-то изучаю по форумах.

Я ведь заикой клавиатурной стану.

Новые блоги и статьи Все статьи Все блоги /
Модель здравосоХранения 6. ESG-повестка и устойчивое развитие; углублённый анализ кадрового бренда anaschu 31.03.2026 В прикрепленном документе раздумья о том, как можно поменять модель в будущем	10 пpимет, которые всегда сбываются Maks 31.03.2026 1. Чтобы, наконец, пришла маршрутка, надо закурить. Если сигарета последняя, маршрутка придет еще до второй затяжки даже вопреки расписанию. 2. Нaдоели зима и снег? Не надо переезжать. Достаточно. . .	Перемещение выделенных строк ТЧ из одного документа в другой Maks 31.03.2026 Реализация из решения ниже выполнена на примере нетипового документа "ВыдачаОборудованияНаСпецтехнику" с единственной табличной частью "ОборудованиеИКомплектующие" разработанного в конфигурации КА2. . . .	Functional First Web Framework Suave DevAlt 30.03.2026 Sauve. IO Апнулись до NET10. Из зависимостей один пакет, работает одинаково хорошо как в режиме проекта так и в интерактивном режиме. из сложностей - чисто функциональный подход. Решил. . .
Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .	Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .

@Gerkss 2 / 2 / 0 Регистрация: 06.05.2013 Сообщений: 50

	Пользовательские процедуры и функции 24.06.2013, 21:52. Показов 1547. Ответов 3 Метки нет (Все метки) Здравствуйте. У меня в VBA вот такая задача: найти периметр фигуры ABCD по заданным сторонам AB, АС и DC. (Определить процедуру для расчета гипотенузы прямоугольного треугольника по его катетам.) Я сделал вот так: Public Sub q() Dim AB As Double Dim AC As Double Dim DC As Double Dim DB As Double Dim BC As Double Dim P As Double AB = InputBox("введите сторону AB") Worksheets(1).Range("G4").Value = AB AC = InputBox("введите сторону AC") Worksheets(1).Range("G5").Value = AC DC = InputBox("введите сторону DC") Worksheets(1).Range("G6").Value = DC BC = Sqr(AB ^ 2 + AC ^ 2) Worksheets(1).Range("G7").Value = BC MsgBox ("Сторона BC равна = " & BC) DB = Sqr(BC ^ 2 + DC ^ 2) Worksheets(1).Range("G8").Value = DB MsgBox ("Сторона DB равна = " & DB) P = AB + AC + DC + DB Worksheets(1).Range("G9").Value = P MsgBox ("периметр равен = " & P) End Sub Считает у меня всё правильно, но препод требует, чтобы была создана под-функция с уравнением считающим гипотенузы и программа вызывала эту под-функцию дважды и высчитывала гипотенузы, с разными катетами... Вот мой 4 угольник: Помогите пожалуйста) Миниатюры 0

@Gerkss 2 / 2 / 0 Регистрация: 06.05.2013 Сообщений: 50
	25.06.2013, 01:35 [ТС]
	@Igor_Tr, спасибо, сообразил по вашему примеру) И вообще большое спасибо этому форуму, если бы не вы, я бы так и остался чайником в VBA. При помощи вас я хоть не много, но начал понимать)! 0

@Igor_Tr 4377 / 661 / 36 Регистрация: 17.01.2010 Сообщений: 2,134
	25.06.2013, 02:13
	Вот незачто... Скоро идти спать. И не дай Бог, что б мне приснилось, что я что-то изучаю по форумах. Я ведь заикой клавиатурной стану. 0