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

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Автоматическая постановка диагноза всем пациентам сразу (Макросы/Sub)

Lebron300

Дата: Понедельник, 22.12.2014, 14:32 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 40% ±

Excel 2003

Здравствуйте уважаемые программисты... можно ли сделать, чтобы при нажатии на форме кнопки "Вывести диагноз на лит" диагноз автоматически выводился на листе сразу всем пациентам (сейчас по щелчку он выводит для каждого отдельно)?
[vba]

Код

Private Sub CommandButton5_Click()
     Dim NORM As Range, R, T
     Set NORM = Range("НОРМА")
     For R = 1 To 7
         Debug.Print Controls("TextBox" & R).Text
         T = CDbl(Replace(Controls("TextBox" & R).Text, ".", ","))

         If T < NORM(R, 2) Or T > NORM(R, 3) Then
             If Val(TextBox2.Text) < 8 Then
                 st = "Легкая степень тяжести."
             ElseIf Val(TextBox2.Text) > 14 Then
                 st = "Тяжелый случай."
             Else
                 st = "Средняя степень тяжести."
                 End If
             End If
         If T < NORM(R, 2) Or T > NORM(R, 3) Then
             If Val(TextBox5.Text) <= 3 Then
             st = st & " " & "1 тип"
             ElseIf Val(TextBox5.Text) > 3 Then
             st = st & " " & "2 тип"
         End If
             Лист2.Cells(ComboBox1.ListIndex + 2, 9) = "Пациент болен. Сахарный диабет!" & vbLf & st
             Exit Sub
         End If
     Next R
     Лист2.Cells(ComboBox1.ListIndex + 2, 9) = "Пациент здоров!"
End Sub

[/vba]

К сообщению приложен файл: 4644779.xls (98.0 Kb)

Сообщение отредактировал Lebron300 - Понедельник, 22.12.2014, 14:35

Ответить

Pelena

Дата: Понедельник, 22.12.2014, 16:01 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19188

Репутация: 4421 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте
[vba]

Код

Private Sub CommandButton5_Click()
     Dim NORM As Range, R, T
     Set NORM = Range("НОРМА")
     Application.ScreenUpdating = False
     With Лист2
         For i = 1 To ComboBox1.ListCount
             For R = 1 To 7
                 T = .Cells(i + 1, R + 1)
                 If T < NORM(R, 2) Or T > NORM(R, 3) Then
                     If .Cells(i + 1, 3) < 8 Then
                         st = "Легкая степень тяжести."
                     ElseIf .Cells(i + 1, 3) > 14 Then
                         st = "Тяжелый случай."
                     Else
                         st = "Средняя степень тяжести."
                     End If
                 End If

                 If T < NORM(R, 2) Or T > NORM(R, 3) Then
                     If .Cells(i + 1, 6) <= 3 Then
                         st = st & " " & "1 тип"
                     ElseIf .Cells(i + 1, 6) > 3 Then
                         st = st & " " & "2 тип"
                     End If
                     .Cells(i + 1, 9) = "Пациент болен. Сахарный диабет!" & vbLf & st
                     Exit For
                 End If
                 If .Cells(i + 1, 9) = "" Then .Cells(i + 1, 9) = "Пациент здоров!"
             Next R
         Next i
     End With
     Application.ScreenUpdating = True
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

СообщениеЗдравствуйте
[vba]

Код

[/vba]

Автор - Pelena
Дата добавления - 22.12.2014 в 16:01

Lebron300

Дата: Понедельник, 22.12.2014, 17:19 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 40% ±

Excel 2003

Pelena, благодарности нет границ...спасибо огромное!!!

Ответить

RAN

Дата: Понедельник, 22.12.2014, 18:46 | Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

A зачем форма?
[vba]

Код

Sub Мяу()
     Dim arr, arr1
     arr = Sheets("Анализы").Range("A1").CurrentRegion.Value
     arr1 = Range("НОРМА").Value
     For i = 2 To UBound(arr)
         arr(i, 9) = "Пациент здоров!"
         For ii = 1 To 7
             If arr(i, ii + 1) < arr1(ii, 2) Or arr(i, ii + 1) > arr1(ii, 3) Then
                 arr(i, 9) = "Пациент болен. Сахарный диабет!" & vbLf & _
                             "Средняя степень тяжести. " & IIf(arr(i, 6) > 3, "2 тип", "1 тип")
                 If arr(i, 3) < 8 Then
                     arr(i, 9) = "Пациент болен. Сахарный диабет!" & vbLf & _
                    "Легкая степень тяжести. " & IIf(arr(i, 6) > 3, "2 тип", "1 тип")
                 ElseIf arr(i, 3) > 14 Then
                     arr(i, 9) = "Пациент болен. Сахарный диабет!" & vbLf & _
                    "Тяжелый случай." & IIf(arr(i, 6) > 3, "2 тип", "1 тип")
                 Else
                 End If
             End If
         Next
     Next
     Sheets("Анализы").Range("A1").CurrentRegion = arr
End Sub

[/vba]

[p.s.]В xls не пролез по размеру[/p.s.]

К сообщению приложен файл: 4644779.xlsb (49.8 Kb)

Быть или не быть, вот в чем загвоздка!

Ответить

Lebron300

Дата: Понедельник, 22.12.2014, 21:17 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 40% ±

Excel 2003

RAN, ну форма для записи пациентов и если по отдельности посмотреть нужно диагнозы... кстати ошибку выдает
[vba]

Код

arr = Sheets("Анализы").Range("A1").CurrentRegion.Value

[/vba]
а нет извините.... это из за формата книги ... огромное спасибо.. тоже вариант)

Сообщение отредактировал Lebron300 - Понедельник, 22.12.2014, 21:20

Ответить

RAN

Дата: Понедельник, 22.12.2014, 22:09 | Сообщение № 6

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Кнопка Мяв

К сообщению приложен файл: 3653433.xlsb (52.5 Kb)

Быть или не быть, вот в чем загвоздка!

Ответить

Lebron300

Дата: Вторник, 23.12.2014, 13:23 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 40% ±

Excel 2003

RAN, да, всё работает... спасибо)

Ответить

Lebron300

Дата: Среда, 24.12.2014, 13:44 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 40% ±

Excel 2003

RAN, я одно только не пойму.... что это за кнопка? ее редактировать нельзя через редактор, хотел обычную поставить...

Ответить

wild_pig

Дата: Среда, 24.12.2014, 15:56 | Сообщение № 9

Группа: Проверенные

Ранг: Обитатель

Сообщений: 517

Репутация: 97 ±

Замечаний: 0% ±

2003, 2013

[offtop]

Цитата Lebron300, 23.12.2014 в 13:23, в сообщении № 7

RAN, да, всё работает... спасибо)

Наблюдая за мучениями на всех форумах с этим заданием вспомнилось
"Вот и вылечил он их, Лимпопо! Вот и вылечил больных. Лимпопо!"[/offtop]

Сообщение отредактировал wild_pig - Среда, 24.12.2014, 15:56

Ответить

Lebron300

Дата: Среда, 24.12.2014, 19:57 | Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 19

Репутация: 0 ±

Замечаний: 40% ±

Excel 2003

wild_pig, ты только за всеми и наблюдаешь.. а дельного ничего.. зачем вообще здесь сидишь?

Ответить

_Boroda_

Дата: Среда, 24.12.2014, 22:18 | Сообщение № 11

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Алексей (wild_pig), между прочим, уже огромному количеству народа помог, так что не ТЕБЕ (алаверды на твое "тыканье") его судить. Он добрейшей души человек, но, видимо, не любит наглецов, как и я, между прочим.
Кстати, почитай еще вот это.
И замечание тебе - нарушение Правил форума п. 5.s.
А еще - здесь грубость очень не приветствуется. И обычно наказывается. Прими к сведению.

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995