Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1 2 След.
RSS
Ввод данных в ячейку с помощью макроса.
 
#1
16.09.2009 01:51:55
Доброй ночи!  
Сломал мозг уже, незнаю как сделать, помогите пожалуйста =(  
Задача такая, при нажатии на любую ячейку столбца появляется календарь и выбиратеся дата (это работает), одновременно с активацией календаря в соседней ячейке справа должна лечь формула записанная через =ЕСЛИ() - постоянно не нее ругается. Пробовал по разному, вот последний вариант:  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
    Dim addr As String  
    Dim formula As String  
    If Target.Cells.Count > 1 Then Exit Sub  
    If Not Application.Intersect(Range("V:V"), Target) Is Nothing Then  
        UserForm1.Show  
        Cells(ActiveCell.Row, ActiveCell.Column + 1).Select  
        addr = ActiveCell.Address()  
        formula = "=ЕСЛИ(Лист1!V19<=Лист2!H$1;1;0)"  
           
        Range(addr) = formula  
 
    End If  
End Sub  
 
(энтерами отделил сторку, на которую ругается)  
Че делать?
 
 
 
#2
16.09.2009 01:58:45
А обязательно вставлять формулу? Почему нельзя сразу в коде выполнить необходимое по условию?
 
 
 
#3
16.09.2009 02:06:11
Попробуйте вот так:  
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
  If Target.Cells.Count > 1 Then Exit Sub  
  If Not Application.Intersect(Range("V:V"), Target) Is Nothing Then  
     UserForm1.Show  
     If Sheets("Лист1").Range("V19") <= Sheets("Лист2").Range("H1") Then  
        ActiveCell.Offset(0, 1) = 1  
     Else  
        ActiveCell.Offset(0, 1) = 0  
     End If  
  End If  
End Sub
 
 
 
#4
16.09.2009 02:09:29
{quote}{login=Юрий М}{date=16.09.2009 01:58}{thema=}{post}А обязательно вставлять формулу? Почему нельзя сразу в коде выполнить необходимое по условию?{/post}{/quote}  
 
Наверное так будет проще, но я не силен в коде, видимо по этому загнал себя в такой тупик...  
 
Попробую объяснить задачу более полно (см.вложение):  
На листе 1 находится база данных количесвто строк в которой не известно, одной из ключевых позиция является дата.  
На листе 2 пользователь жаждет получить отчет, для этого он задает в ячейках G1 и H1 нач. и кон. даты отчетного периода и получает выборку всех попадающих в диапазон по дате строк, но не всех столбцов (нужные названия совпадают). Кроме этого должен появиться счетчик, показывающий количество строк лежащих на листе 2, причем счетчик зависимый от стандартного "автофильтра" - но до этого я еще не дошел, застрял раньше...
 
 
 
#5
16.09.2009 02:11:07
1. У меня нет 2007-го (прочтите Правила).  
2. Проверьте мой код.
 
 
 
#6
16.09.2009 02:16:42
{quote}{login=Юрий М}{date=16.09.2009 02:11}{thema=}{post}1. У меня нет 2007-го (прочтите Правила).  
2. Проверьте мой код.{/post}{/quote}  
 
Виноват, исправляюсь.
 
 
 
#7
16.09.2009 02:21:31
{quote}{login=Юрий М}{date=16.09.2009 02:11}{thema=}{post}1. У меня нет 2007-го (прочтите Правила).  
2. Проверьте мой код.{/post}{/quote}  
 
Видимо я неправильно объяснил, V19 не имеет отношения к проверки, нужно проверять ячейку, в которую только что упала дата, а результат проверки в соседнюю справа...
 
 
 
#8
16.09.2009 02:24:14
1. Вставьте мой код взамен Вашего.  
2. В модуле формы добавьте строку:  
Private Sub Calendar1_Click()  
    ActiveCell = Calendar1.Value  
    ActiveCell.NumberFormat = "dd/mm/yy"  
    Unload Me 'Вот эту строку добавьте  
End Sub
 
 
 
#9
16.09.2009 02:25:40
{quote}{login=disz}{date=16.09.2009 02:21}{thema=Re: }{post}{quote}{login=Юрий М}{date=16.09.2009 02:11}{thema=}{post}1. У меня нет 2007-го (прочтите Правила).  
2. Проверьте мой код.{/post}{/quote}Видимо я неправильно объяснил, V19 не имеет отношения к проверки, нужно проверять ячейку, в которую только что упала дата, а результат проверки в соседнюю справа...{/post}{/quote}  
Проверять на что? С чем сравнивать?
 
 
 
#10
16.09.2009 02:28:21
{quote}{login=Юрий М}{date=16.09.2009 02:25}{thema=Re: Re: }{post}{quote}{login=disz}{date=16.09.2009 02:21}{thema=Re: }{post}{quote}{login=Юрий М}{date=16.09.2009 02:11}{thema=}{post}1. У меня нет 2007-го (прочтите Правила).  
2. Проверьте мой код.{/post}{/quote}Видимо я неправильно объяснил, V19 не имеет отношения к проверки, нужно проверять ячейку, в которую только что упала дата, а результат проверки в соседнюю справа...{/post}{/quote}  
Проверять на что? С чем сравнивать?{/post}{/quote}  
 
А сравнивать, правильно, с H1 на втором листе  
<= Sheets("Лист2").Range("H1")  
 
Если не затруднит, посомтрите файл пожалуйста, я его нормально пересохранил...
 
 
 
#11
16.09.2009 02:31:51
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
  If Target.Cells.Count > 1 Then Exit Sub  
  If Not Application.Intersect(Range("V:V"), Target) Is Nothing Then  
     UserForm1.Show  
     If ActiveCell <= Sheets("Лист2").Range("H1") Then  
        ActiveCell.Offset(0, 1) = 1  
     Else  
        ActiveCell.Offset(0, 1) = 0  
     End If  
  End If  
End Sub
 
 
 
#12
16.09.2009 02:44:18
{quote}{login=Юрий М}{date=16.09.2009 02:31}{thema=}{post}Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
  If Target.Cells.Count > 1 Then Exit Sub  
  If Not Application.Intersect(Range("V:V"), Target) Is Nothing Then  
     UserForm1.Show  
     If ActiveCell <= Sheets("Лист2").Range("H1") Then  
        ActiveCell.Offset(0, 1) = 1  
     Else  
        ActiveCell.Offset(0, 1) = 0  
     End If  
  End If  
End Sub{/post}{/quote}  
Юрий, спасибо большое, работает! )))  
А не намекнете, какими средствами заполнять строки на листе 2 ?  
Допустим напротив нужных строк на листе 1 у меня будут стоять "1", как сделать чтобы он каждый раз их проверял и добавлял на второй лист только еденички?
 
 
 
#13
16.09.2009 02:48:49
1. Где на листе1 будут единички?  
2. Куда добавлять на лист2? В первую непустую?  
3. Что добавлять?
 
 
 
#14
16.09.2009 02:58:18
{quote}{login=Юрий М}{date=16.09.2009 02:48}{thema=}{post}1. Где на листе1 будут единички?  
2. Куда добавлять на лист2? В первую непустую?  
3. Что добавлять?{/post}{/quote}  
 
1. Y столбец "Проверка даты" (на данный момент не работает т.к. X и Y (столбцы) без формул)  
2. На лист 2 наоборот, в первую пустую по совпадению названий в шапке.  
3. Все что в шапке на листе 2 т.к. на листе 1 данные избыточные.
 
 
 
#15
16.09.2009 03:14:05
Копировать данные из строки в которой в столбце Y значение =1? Формулы там есть. Может Вы про что другое говорите?
 
 
 
#16
16.09.2009 03:19:14
{quote}{login=Юрий М}{date=16.09.2009 03:14}{thema=}{post}Копировать данные из строки в которой в столбце Y значение =1? Формулы там есть. Может Вы про что другое говорите?{/post}{/quote}  
 
Да, именно из этих строк (неизвестно заранее сколько их будет)  
Формулы там от руки вбиты, если добавить строки - формулы придется растягивать, я про это говорю, но мне хотябы и так. Не могу сообразить как проверять на условие Y =1 и записывать в каждую след пустую на листе 2...
 
 
 
#17
16.09.2009 03:29:08
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
Dim LastRow As Long  
LastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row  
  If Target.Cells.Count > 1 Then Exit Sub  
  If Not Application.Intersect(Range("V:V"), Target) Is Nothing Then  
     UserForm1.Show  
     If ActiveCell <= Sheets("Лист2").Range("H1") Then  
        ActiveCell.Offset(0, 1) = 1  
     Else  
        ActiveCell.Offset(0, 1) = 0  
     End If  
     With Sheets("Лист2")  
     If ActiveCell.Offset(0, 3) = 1 Then  
        ActiveCell.Offset(0, -21).Copy .Cells(LastRow + 1, 1)  
        ActiveCell.Offset(0, -19).Copy .Cells(LastRow + 1, 2)  
        ActiveCell.Offset(0, -5).Copy .Cells(LastRow + 1, 3)  
        ActiveCell.Offset(0, -15).Copy .Cells(LastRow + 1, 4)  
        ActiveCell.Offset(0, -14).Copy .Cells(LastRow + 1, 5)  
        ActiveCell.Copy .Cells(LastRow + 1, 6)  
     End If  
     End With  
  End If  
End Sub  
 
А про формулы - тоже сделайте в макросе и не нужно будет ничего растягивать.
 
 
 
#18
16.09.2009 03:31:56
Уточнение: не формулы в макросе, а вычисления.
 
 
 
#19
16.09.2009 03:39:20
Прошу прощения: после строки:  
ActiveCell.Copy .Cells(LastRow + 1, 6)  
добавьте вот такую строку:  
LastRow = LastRow + 1
 
 
 
#20
16.09.2009 03:53:02
{quote}{login=Юрий М}{date=16.09.2009 03:31}{thema=}{post}Уточнение: не формулы в макросе, а вычисления.{/post}{/quote}  
 
{quote}{login=Юрий М}{date=16.09.2009 03:39}{thema=}{post}Прошу прощения: после строки:  
ActiveCell.Copy .Cells(LastRow + 1, 6)  
добавьте вот такую строку:  
LastRow = LastRow + 1{/post}{/quote}  
 
Вот так получилось с вычислениями:  
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
Dim LastRow As Long  
Dim min As String  
Dim max As String  
LastRow = Sheets("Ëèñò2").Cells(Rows.Count, 1).End(xlUp).Row  
If Target.Cells.Count > 1 Then Exit Sub  
If Not Application.Intersect(Range("V:V"), Target) Is Nothing Then  
UserForm1.Show  
If ActiveCell <= Sheets("Ëèñò2").Range("H1") Then  
ActiveCell.Offset(0, 1) = 1  
Else  
ActiveCell.Offset(0, 1) = 0  
End If  
If ActiveCell >= Sheets("Ëèñò2").Range("G1") Then  
ActiveCell.Offset(0, 2) = 1  
Else  
ActiveCell.Offset(0, 2) = 0  
End If  
min = ActiveCell.Offset(0, 1)  
max = ActiveCell.Offset(0, 2)  
ActiveCell.Offset(0, 3) = min * max  
With Sheets("Ëèñò2")  
If ActiveCell.Offset(0, 3) = 1 Then  
ActiveCell.Offset(0, -21).Copy .Cells(LastRow + 1, 1)  
ActiveCell.Offset(0, -19).Copy .Cells(LastRow + 1, 2)  
ActiveCell.Offset(0, -5).Copy .Cells(LastRow + 1, 3)  
ActiveCell.Offset(0, -15).Copy .Cells(LastRow + 1, 4)  
ActiveCell.Offset(0, -14).Copy .Cells(LastRow + 1, 5)  
ActiveCell.Copy .Cells(LastRow + 1, 6)  
LastRow = LastRow + 1  
End If  
End With  
End If  
End Sub  
Вроде работает ) Спасибо огромное еще раз!!!  
Юрий, а вот еще интересный вопрос, возможно ли, "обновлять информацию" т.е., например, если я удаляю строки или меняю дату (иногда же людт ошибаюстся, промахиваются) - эти изменения не вносятся автоматически на лист 2...
 
 
 
#21
16.09.2009 03:54:27
Что-то с форумом, я другой текст писал... 0_о  
 
Вот так получилось с вычислениями:  
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
Dim LastRow As Long  
Dim min As String  
Dim max As String  
LastRow = Sheets("Ëèñò2").Cells(Rows.Count, 1).End(xlUp).Row  
If Target.Cells.Count > 1 Then Exit Sub  
If Not Application.Intersect(Range("V:V"), Target) Is Nothing Then  
UserForm1.Show  
If ActiveCell <= Sheets("Ëèñò2").Range("H1") Then  
ActiveCell.Offset(0, 1) = 1  
Else  
ActiveCell.Offset(0, 1) = 0  
End If  
If ActiveCell >= Sheets("Ëèñò2").Range("G1") Then  
ActiveCell.Offset(0, 2) = 1  
Else  
ActiveCell.Offset(0, 2) = 0  
End If  
min = ActiveCell.Offset(0, 1)  
max = ActiveCell.Offset(0, 2)  
ActiveCell.Offset(0, 3) = min * max  
With Sheets("Ëèñò2")  
If ActiveCell.Offset(0, 3) = 1 Then  
ActiveCell.Offset(0, -21).Copy .Cells(LastRow + 1, 1)  
ActiveCell.Offset(0, -19).Copy .Cells(LastRow + 1, 2)  
ActiveCell.Offset(0, -5).Copy .Cells(LastRow + 1, 3)  
ActiveCell.Offset(0, -15).Copy .Cells(LastRow + 1, 4)  
ActiveCell.Offset(0, -14).Copy .Cells(LastRow + 1, 5)  
ActiveCell.Copy .Cells(LastRow + 1, 6)  
LastRow = LastRow + 1  
End If  
End With  
End If  
End Sub  
Вроде работает ) Спасибо огромное еще раз!!!  
Юрий, а вот еще интересный вопрос, возможно ли, "обновлять информацию" т.е., например, если я удаляю строки или меняю дату (иногда же людт ошибаюстся, промахиваются) - эти изменения не вносятся автоматически на лист 2...
 
 
 
#22
16.09.2009 04:05:18
Избегайте избыточного (и неужного порой) цитирования. Вот зачем Вы весь код продублировали? Тогда всё, что написали и будет отражено в сообщении. По поводу удаления строк. Непонятно где Вы собираетесь удалять строки. Нужно будет писать кучу проверок. Будьте просто внимательны. Данные буду копироваться, если контрольная ячейка = 1. Если действие было ошибочным - придётся эту строку на листе 2 удалять вручную. Повторюсь - можно автоматизировать удаление строки с листа2 при удалении с первого, но это дополнительные проверки.
 
 
 
#23
16.09.2009 04:07:18
И ещё: когда копируете код из редактора - следите за раскладкой клавиатуры - должна быть RU
 
 
 
#24
16.09.2009 10:39:01
{quote}{login=Юрий М}{date=16.09.2009 04:05}{thema=}{post}Избегайте избыточного (и неужного порой) цитирования. Вот зачем Вы весь код продублировали? Тогда всё, что написали и будет отражено в сообщении. По поводу удаления строк. Непонятно где Вы собираетесь удалять строки. Нужно будет писать кучу проверок. Будьте просто внимательны. Данные буду копироваться, если контрольная ячейка = 1. Если действие было ошибочным - придётся эту строку на листе 2 удалять вручную. Повторюсь - можно автоматизировать удаление строки с листа2 при удалении с первого, но это дополнительные проверки.{/post}{/quote}  
 
Хорошо, постараюсь не засорять форум, а в 4 утра мозг уже вскипает, вот и нафигарил )  
мне такое нужно, не только я буду работать с этим, а людям не объяснишь, что ошибать нельзя =(  
Есть идейка сделать на втором листе кнопку, по клику на которую он будет очищать отчет и заново пробегать по всем строкам помечченным еденичкой )    
Как Вам такая идея?
 
 
 
#25
16.09.2009 12:06:30
Опять Вы с цитированием... :-) Избегайте цитирования без особой необходимости. Иногда действительно бывает нужно (особенно что-то выделив в цитируем тексте). А так... По вопросу: идея на мой взгляд правильная - если пользователь заметил, что допустил ошибку, то жмёт на кнопочку (не обязательно на втором листе) и лист перепишется заново по данным с первого листа.
 
 
 
#26
16.09.2009 16:32:25
Все, прекратил, привычка вторая натура )))  
 
Сейчас как раз занимаюсь макросом для кнопки, если чего получится выложу тут...  
Вопросик короткий:  
Set findRange = .Range("C1:C" & LastRow).Find(1)  
даст мне адресс ячейки с еденичкой или я неправильно функцию Find использую?
 
 
 
#27
16.09.2009 16:59:44
А самому проверить?
 
 
 
#28
16.09.2009 17:00:45
The_Prist, спасибо!
 
 
 
#29
16.09.2009 17:02:07
Я бы сейчас проверил - работает, а потом бы вылез "не очень приятный сюрприз" в процессе использования... =)
 
 
 
#30
16.09.2009 21:20:29
Зациклился, на макросе к кнопке AddInf называется в модуле 2, посмотрите Пожалуйста...  
Где я там накосячил?
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх