Страницы: 1
RSS
Подсчёт процедурных единиц за определённый период времени
 

Здравствуйте, ув. форумчане.

По работе приходится подсчитывать количество пациентов, процедур и процедурных единиц за определённый период времени (месяц, квартал …). Ежемесячно «вручную» считал и заносил в таблицу вышеперечисленные данные, а самостоятельно написанные макросы выдавали сумму этих данных в соответствующих ячейках. Однажды мне надоело считать «крестики» и я решил полностью автоматизировать этот процесс.

С задачей подсчёта количества пациентов с разбивкой по отделениям (в прилагаемом файле - Лист "Пациенты") я справился (Макрос 1). А, вот, с подсчётом количества процедур (Макрос 2) возникли проблемы – в ячейках появляются какие-то «левые» числа. Понимаю, что нужно правильно прописать код макроса, но, к сожалению, в программировании я полный ноль, катастрофически не хватает знаний в области VBA …

Просьба помочь в решении данной задачи (прописать код или ткнуть носом, где «копать»), а с подсчётом единиц, надеюсь, справлюсь сам (опираясь на Ваши советы). Заранее благодарен.

P.S. Несколько дней чтения Форума и поисков в Сети не помогли решить проблему (((

P.P.S. Пользуюсь MS Office 2003.

Изменено: samass - 08.11.2019 23:44:00
 
Цитата
samass написал:
в ячейках появляются какие-то «левые» числа
Появляется то, что вы прописали. Только непонятно зачем вы количество всех указанных процедур умножаете на количество различных отделений в больнице.
 
bigorq, я писал выше, что в программировании не силён, моя сфера деятельности - медицина. Хотел самостоятельно, опираясь на различную литературу по VBA, облегчить себе рутинную работу. Если не затруднит, помогите разобраться, где я накосячил и как это можно исправить ....
 
Цитата
bigorq написал:
зачем вы количество всех указанных процедур умножаете на количество различных отделений в больнице.
Попытаюсь объяснить "логику" своих действий.

Числа в колонке "J(Отд.)" это не количество, но название отделения (первое, второе и т.д.). Задача - в диапазоне "Октябрь!K:AO" подсчитать количество заполненных ячеек в соответствии с названием отделения и количеством человек этого отделения и вывести сумму на Лист "Процедуры" с разбивкой по отделениям. В макросе я попытался объединить две функции "СЧЁТЕСЛИ", одна из которых отлично работает для подсчёта количества человек (Лист "Пациенты"). Прошу меня извинить, если объяснил сумбурно, математика - не мой конёк )))
Изменено: samass - 08.11.2019 23:56:47
 
samass, Если, правильно понял задачу, то макрос для "Пациенты"(запускать с листа " Пациенты")
Код
Sub Пациенты()
Dim tt As Integer
Dim i As Long, j As Long
Dim Rng As Range, x As Range
Static Txt As String
  Set Rng = Range("A1:U1")
  Txt = InputBox("Введите месяц", "Поиск в строке '1'", Txt)
  If Txt = "" Then Exit Sub
  Set x = Rng.Find(what:=Txt)
  For i = 2 To 12
     For j = 2 To 25
        If Cells(i, 1) = Sheets(Txt).Cells(j, 10) Then tt = tt + 1
     Next
          If tt <> 0 Then
          Cells(i, x.Column) = tt
          tt = 0
       End If
   Next
End Sub

Для "Процедуры"   (запускать с листа " Процедуры")
Код
Sub Процедуры()
Dim tt As Single
Dim i As Long, j As Long
Dim Rng As Range, x As Range
Static Txt As String
  Set Rng = Range("A1:U1")
  Txt = InputBox("Введите месяц", "Поиск в строке '1'", Txt)
  If Txt = "" Then Exit Sub
  Set x = Rng.Find(what:=Txt)
    With Sheets(Txt)
      For i = 2 To 12
        For j = 2 To 25
          If Cells(i, 1) = Sheets(Txt).Cells(j, 10) Then tt = tt + Application.Sum(.Range(.Cells(j, 11), .Cells(j, 41)))
        Next
            If tt <> 0 Then
            Cells(i, x.Column) = tt
            tt = 0
          End If
      Next
    End With
End Sub

Важно: отделения на всех листах должно быть написано однообразно.
Перезалил файл
Изменено: casag - 09.11.2019 01:07:01
 
casag, спасибо за участие, тестировать буду завтра. Всех благ  :) ...
 
samass, в макросе "Процедуры" считается сумма чисел в ячейках по каждому отделению.Если нужно просто количество заполненных ячеек по отделениям ,то тогда так
Код
Sub ПроцедурыЯчейки()
Dim tt As Integer
Dim i As Long, j As Long, n As Long
Dim Rng As Range, x As Range
Static Txt As String
  Set Rng = Range("A1:U1")
  Txt = InputBox("Введите месяц", "Поиск в строке '1'", Txt)
  If Txt = "" Then Exit Sub
  Set x = Rng.Find(what:=Txt)
    With Sheets(Txt)
      For i = 2 To 12
        For j = 2 To 25
          If Cells(i, 1) = Sheets(Txt).Cells(j, 10) Then
             For n = 11 To 41
                If Sheets(Txt).Cells(j, n) <> 0 Then tt = tt + 1
             Next
            End If
         Next
            If tt <> 0 Then
            Cells(i, x.Column) = tt
            tt = 0
          End If
      Next
    End With
End Sub
 
Здравствуйте, ув. casag! Вы всё правильно поняли и сделали то, что мне нужно   ...
Правда, для полного счастья нужно осветить ещё пару вопросов:
Вопрос №1 -  Макрос, который Вы назвали "Процедуры" (сумма чисел в ячейках  по каждому отделению) выполняет задачу для Листа "Единицы", но попытка  запустить его с этого Листа не увенчалась успехом. К моему большому  сожалению, не смог самостоятельно разобраться, что нужно изменить в  коде, чтобы макрос "Процедуры (Единицы)" запускался с Листа "Единицы".
Вопрос №2 (не принципиальный) - В Excel2010 всё прекрасно работает, чего не скажешь про Excel2003.  Возможно ли как-то адаптировать Ваши макросы под старую версию Excel или  я хочу слишком многого?
Заранее благодарю за ответ.
Изменено: samass - 09.11.2019 19:34:17
 
samass,Добрый день!

Макрос не привязан жестко к листу, просто выгрузка данных пойдет на тот лист, с которого вы его запустите. А не срабатывает макрос на листе " Единицы", потому что названия отделений на листе у вас " Отд 01", а на листе "Октябрь" просто "1". Я писал об этом выше. Названия отделений должны быть написаны как угодно, но везде однообразно.
Почему не работает на 2003, пока не знаю. Проверить не на чем. Опишите в чем сбой, что не работает.
Кстати, вчера я перезалил файл, в старом файле был отладочный файл , если еще не скачали
 
Цитата
casag написал:
Названия отделений должны быть написаны как угодно, но везде однообразно.Почему не работает на 2003, пока не знаю.
Спасибо, всё работает и в Excel2003 тоже !!!
Проблема, действительно, заключалась в неправильном написании названий отделений на Листах - Пациенты, Процедуры, Единицы (sorry за мою невнимательность). Ещё раз сердечно благодарю Вас за помощь, удачи!
Страницы: 1
Наверх