Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Главное меню

Выборка значений

Автор marsel_xm, 21.02.2011, 12:32

« назад - далее »

marsel_xm

Здравствуйте, проблема вот в чем: есть ввод в лист "базу" данных из листа "ввод пациента" с помощью макроса, а именно Фио врача фио пациента, время с интервалом в пол часа и ввод даты, нужно чтоб при вводе даты, то есть как мы выбирим дату в столбце предположим D выводилось не занятое время из возможных вариантов на эту дату у этого врача(то есть по нажатию на ячейку B4 (ввод даты с помощью календаря) на листе "ввод пациента")
макрос нажатия на ячейку B4 собственно куда и надо вставить этот код:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     If Target.Cells.Count > 1 Then Exit Sub
     If Not Application.Intersect(Range("B4"), Target) Is Nothing Then
         Calendar.Show       
     End If
End Sub

nilem

имхо, здесь лучше подойдут списки, чем комбобоксы. Вот, посмотрите.

marsel_xm

Спасибо большое  :),  можно и со списками.

Wasilic

Как я понял задача для регистратуры?!
Ну звоню я Вам и прошу записать меня к доктору.
Записали на 10.00, спасибо приду, а через 5 минут звоню и, извиняясь прошу записать меня на другое время. Ну так получилось, ну немогу на 10.00. Ваши действия?
ИМХО, Вам надо организовать расписание совсем иначе.
Вы же ничего визуально не видите, ни времени, ни дня.
Для удобства и просмотра расписания, лично я сделал бы расписание например так:
Может и я на что сгожусь ... Если сгодился, можете меня по+благодарить+.

marsel_xm

Хорошее замечание, но до этого у меня так и было, мне она была  крайне не удобна... проблемы с формотированием, матанием по листам, и с последующим выводом на печать, думаю к форме где дабавление в базу добавить и удаление из базы.

Wasilic

Цитата: marsel_xm от 22.02.2011, 08:13
до этого у меня так и было, мне она была  крайне не удобна... проблемы с формотированием, матанием по листам, и с последующим выводом на печать
Если так и было, то уверен что не так. Оперативность в записи к врачу та же самая – в обеих случаях врач выбирается из списка и МОТАНИЕ  по листам автоматическое, а печать и обработка таблиц – это уже мелочь.
Но, вольному воля!  Успехов.
Может и я на что сгожусь ... Если сгодился, можете меня по+благодарить+.

marsel_xm

Цитата: nilem от 21.02.2011, 16:04
имхо, здесь лучше подойдут списки, чем комбобоксы. Вот, посмотрите.

Вы код упростили.
If [OR(B2:B5="")] Then MsgBox "Çàïîëíèòå âñå ïîëÿ", 64: Exit Sub
Set rng = Range("B2:B5")
With baza
    lRow = Application.CountA(.Range("A:A")) + 1
    .Range(.Cells(lRow, 1), .Cells(lRow, 4)) = Application.Transpose(rng)
End With

Как сделать вывод без транспонирования?
.Range(.Cells(lRow, 1), .Cells(lRow, 4)).Value = rng не работает, я так понимаю не правильно присваивание происходит?

nilem

Видимо, задача изменилась...
Без транспонирования получим такой же диапазон "в столбик", попробуйте для примера:
Sub ПереносДанныхБаза222()
Dim rng As Range
Set rng = Sheets("Ввод пациента").Range("B2:B5")
With baza
   Range(.Cells(1, 6), .Cells(4, 6)).Value = rng.Value
End With
'или так
'baza.Range("F1:F4").Value = rng.Value
End Sub



marsel_xm

#8
Цитата: nilem от 24.02.2011, 14:04
Видимо, задача изменилась...

Спасибо еще раз, как я не догадался, что Value=Value. Вот теперь немного другая рода моя недоходчивость:

Sub DocTimeOtchet()
Dim x, i As Long, lRow As Long

With baza
   x = .Range("B2:D" & .Cells(Rows.Count, 2).End(xlUp).Row).Value
End With

For i = 1 To UBound(x)
   If x(i, 1) = [b14] Then
       If x(i, 2) = [b15] Then
         With Pech
            lRow = Application.CountA(.Range("A:A")) + 1
           .Range(.Cells(lRow, 1), .Cells(lRow, 4)).Value = x(i).Value
         End With
         Else: MsgBox ("На эту дату и этого врача нет данных")
       End If
   End If
Next i
End Sub


неправильно присваиваю строку = x(i).Value как записать x(i, 1-4).Value можно в цикле конечно записать, но я думаю есть проще способ.

_Boroda_

Например, так:
.Cells(lRow, 1) .Resize(, 4).Value = x(i).Value
Скажи мне, кудесник, любимец ба'гов...



Яндекс-деньги: 41001632713405
Webmoney: R289877159277; Z102172301748; E177867141995

marsel_xm

#10
Цитата: _Boroda_ от 24.02.2011, 21:53
Например, так:
.Cells(lRow, 1) .Resize(, 4).Value = x(i).Value


На ваше дополнение выдает Subscript Out of Range, ошибка 9
немного поменял код, но выдает такую же ошибку

Sub DocTimeOtchet()
Dim x, i As Long, lRow As Long, Nal As Boolean
Nal = True
With baza
   x = .Range("B1:D" & .Cells(Rows.Count, 2).End(xlUp).Row).Value
End With

For i = 1 To UBound(x)
   If x(i, 2) = [b14] Then
       If x(i, 3) = [b15] Then
         With Pech
            lRow = Application.CountA(.Range("A:A")) + 1
            .Cells(lRow, 1).Value = x(i, 4).Value
            .Cells(lRow, 2).Value = x(i, 1).Value
         End With
         Nal = False
       End If
   End If
Next i
If Nal Then
MsgBox ("На данный день и этого врача данных нет")
End If
End Sub

все, решено,ошибка была с массивами.
может кому интересно исправленный пост оставлю. :)

marsel_xm

Цитата: nilem от 21.02.2011, 16:04
имхо, здесь лучше подойдут списки, чем комбобоксы. Вот, посмотрите.
поблема возникла(((
при запуске на других машинах выходит постоянно собщение Automation error
и жалуется на эту строчку

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Range("B4"), Target) Is Nothing Then Calendar.Show
If Not Intersect(Range("B15"), Target) Is Nothing Then Calendar.Show
If Not Intersect(Range("B5"), Target) Is Nothing Then VR
If Not Intersect(Range("B5"), Target) Is Nothing Then DocTime
If Not Intersect(Range("B14"), Target) Is Nothing Then DelOld
End Sub

читал в инете что возникает она при create object... может своими функциями её заменить...
что делать, товарищи эксперты?

nilem

Это происходит скорее всего из-за того, что на др. машинах не установлен контрол Календарь.
Используйте пользовательские календари (в примере сделайте двойной клик по зеленому диапазону).
А не лучше вручную записывать дату (см. в архиве)?

marsel_xm

#13
Цитата: nilem от 03.03.2011, 11:33
Это происходит скорее всего из-за того, что на др. машинах не установлен контрол Календарь.
Используйте пользовательские календари (в примере сделайте двойной клик по зеленому диапазону).
А не лучше вручную записывать дату (см. в архиве)?

Была другая ошибка, поскольку не было библиотеки календарь11, установил библиотеку так как на своей машинке, и стало выдавать у них Automation error  при нажати на любую ячейку листа Ввод пациента.
Дату думаю лучше с календарём вводить...

в переносе данных
.Cells(2, 1) = "Фамилия" '???
это для того что в столбце А она не пустовала, поскольку
lRow = Application.CountA(.Range("A:A")) + 1

я так понял считает все не пустые строки, а если Cells(2, 1) пустая, то она перезапишет последнюю строку, не сообразил как сделать счетчик с А4....

Далее DelOld ()  удаляет записи старше 20-ти дней...
А в целом спасибо, буду разбираться...только не понятно в чем разница
If Target.Address(0, 0) = "B5" Then Call DocTime
и
If Not Intersect(Range("B5"), Target) Is Nothing Then DocTime
может в этом вся проблема!

nilem

If Target.Address(0, 0) = "B5" Then Call DocTime
и
If Not Intersect(Range("B5"), Target) Is Nothing Then DocTime
никакой разницы. Просто с Address вроде покороче.