Гость
Войти | Профиль | Очистить
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / условия в процедуре Worksheet_Change / 12 сообщений из 12, страница 1 из 1
04.05.2012, 17:50
    #37782599
martinezo
martinezo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
Здравствуйте, форумчане, прошу помочь разобраться начинающему программисту с работой в процедуре
Worksheet_Change: написал макрос, который работает так, если значение в ячейке G2 пустое, то диапазон ячеек K2:P2 очищается, и так дальше для G3 и т.д.

не получается следующее: то же самое но для другого диапазона ячеек:
если значение в ячейке R2 пустое, то диапазон ячеек W2:AA2 очищается, и так дальше для R3 и т.д.

вот текст макроса (файл во вложении):


Код: vbnet
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.
30.
31.
32.
33.
34.
35.
36.
37.
38.
Private Sub Worksheet_Change(ByVal Target As Range)
'V = Range("A2:B2").Value

K = Target.Column 'определение номера колонки вводимого значения
R = Target.Row 'определение номера ряда вводимого значения
'ADDR = "G" & K
'Addr2 = "K" & K & ":" & "O" & K ' определение диапазона ячеек, кот. надо удалять в дальшейшем
'Addr1 = "O" & K
'alb = "abcdefghj"
LeftColl = 11
RightCol = 15


If ((K < LeftColl) Or (K > RightCol)) Then
Exit Sub
End If

If Range("G" & R).Value = "" Then

Target.Select
Selection.ClearContents
Exit Sub
End If

LeftColll = 23
RightCol = 27


If ((K < LeftColl) Or (K > RightCol)) Then
Exit Sub
End If

If Range("R" & R).Value = "" Then

Target.Select
Selection.ClearContents
Exit Sub
End If



Модератор: Предупреждаю еще раз насчет использования тэгов оформления кода - FAQ

Заранее благодарен за помощь
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.05.2012, 09:10
    #37783144
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
 
Код: vbnet
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.
30.
31.
32.
33.
34.
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim K As Long, R As Long
  Dim K2 As Long
  Dim ColOfs As Long, ColCnt As Long

  K = Target.Column 'определение номера колонки вводимого значения
  R = Target.Row 'определение номера ряда вводимого значения

  If K >= 11 And K <= 16 Then ' столбцы P:K
    K2 = 7                    ' номер столбца G
    ColOfs = 4                ' расстояние от столбца G до столбца K
    ColCnt = 6                ' количество столбцов в диапазоне P:K
  ElseIf If K >= 23 And K <= 27 Then ' столбцы W:AA
    K2 = 18                   ' номер столбца R
    ColOfs = 5                ' расстояние от столбца R до столбца W
    ColCnt = 5                ' количество столбцов в диапазоне W:AA
  ElseIf ... And ... Then
    K2 = ...
    Ofs = ...
    ColCnt = ...
  Else
    Exit Sub
  End If

  With Target.Parent.Cells(R, K2)
' Возможно, ссылка на родительский элемент лишняя (и даже вредна), и корректно будет работать
' обращение к Cells() без указания контекста. Не проверял.
    If .Value2 = "" Then ' если значение ячейки в соответствующем столбце пустое
      ' очистить соответствующий диапазон
      .Offset(0, ColOfs).Resize( ,ColCnt).ClearContents
    End If
  End With

End Sub

...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.05.2012, 09:20
    #37783161
катастрофа
катастрофа
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
скукотища,
ElseIf If K >= 23 And K <= 27 Then ' столбцы W:AA - червоная строка, ересь?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.05.2012, 10:35
    #37783244
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
катастрофаскукотища,
ElseIf If K >= 23 And K <= 27 Then ' столбцы W:AA - червоная строка, ересь?
Ересь.
Копипастил невнимательно. If - было явно лишним.
Код: vbnet
1.
2.
' Фикс:
ElseIf K >= 23 And K <= 27 Then    ' столбцы W:AA
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.05.2012, 10:58
    #37783274
martinezo
martinezo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
катастрофаскукотища,
ElseIf If K >= 23 And K <= 27 Then ' столбцы W:AA - червоная строка, ересь?

Спасибо, только один If (второй) лишний
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.05.2012, 11:07
    #37783287
martinezo
martinezo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
скукотища+
 
Код: vbnet
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.
30.
31.
32.
33.
34.
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim K As Long, R As Long
  Dim K2 As Long
  Dim ColOfs As Long, ColCnt As Long

  K = Target.Column 'определение номера колонки вводимого значения
  R = Target.Row 'определение номера ряда вводимого значения

  If K >= 11 And K <= 16 Then ' столбцы P:K
    K2 = 7                    ' номер столбца G
    ColOfs = 4                ' расстояние от столбца G до столбца K
    ColCnt = 6                ' количество столбцов в диапазоне P:K
  ElseIf If K >= 23 And K <= 27 Then ' столбцы W:AA
    K2 = 18                   ' номер столбца R
    ColOfs = 5                ' расстояние от столбца R до столбца W
    ColCnt = 5                ' количество столбцов в диапазоне W:AA
  ElseIf ... And ... Then
    K2 = ...
    Ofs = ...
    ColCnt = ...
  Else
    Exit Sub
  End If

  With Target.Parent.Cells(R, K2)
' Возможно, ссылка на родительский элемент лишняя (и даже вредна), и корректно будет работать
' обращение к Cells() без указания контекста. Не проверял.
    If .Value2 = "" Then ' если значение ячейки в соответствующем столбце пустое
      ' очистить соответствующий диапазон
      .Offset(0, ColOfs).Resize( ,ColCnt).ClearContents
    End If
  End With

End Sub



Спасибо, все работает теперь, кроме одного: я ввожу данные в столбец G начиная со второго ряда и если он пустой то пустой становится интервал ячеек в диапазоне P:K, аналогично для столбца R и диапазона W:AA, как можно отредактировать код, чтоб при редактировании ячееек G и R в первом ряду не очищалось содержимое диапазонов ячеек P:K и W:AA (тк в первом ряду будет шапка к таблице)?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.05.2012, 11:18
    #37783306
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
> martinezo
> ...чтоб при редактировании ячееек G и R в первом ряду не очищалось содержимое диапазонов
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
...
  Dim ColOfs As Long, ColCnt As Long

  R = Target.Row 'определение номера ряда вводимого значения
 ' проверить номер редактируемой строки
  If R < 2 Then Exit Sub 
  K = Target.Column 'определение номера колонки вводимого значения

  If K >= 11 And K <= 16 Then ' столбцы P:K
...
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.05.2012, 17:14
    #37784000
martinezo
martinezo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
 
текст программы
Private Sub Worksheet_Change(ByVal Target As Range)
Dim K As Long, R As Long
Dim K2 As Long
Dim ColOfs As Long, ColCnt As Long

K = Target.Column 'определение номера колонки вводимого значения
R = Target.Row 'определение номера ряда вводимого значения
If R < 2 Then Exit Sub
If K >= 11 And K <= 16 Then ' столбцы P:K
K2 = 7 ' номер столбца G
ColOfs = 4 ' расстояние от столбца G до столбца K
ColCnt = 6 ' количество столбцов в диапазоне P:K
'ElseIf K = 7 And Range("K2" & R).Value <> "" Then MsgBox "111111111111"

ElseIf K >= 23 And K <= 27 Then ' столбцы W:AA
K2 = 18 ' номер столбца R
ColOfs = 5 ' расстояние от столбца R до столбца W
ColCnt = 5 ' количество столбцов в диапазоне W:AA
ElseIf K = 7 And Range("G" & R).Value <> "" Then
Range("O" & R).Select
ElseIf K = 7 And Range("G" & R).Value <> "" Then
MsgBox "заполни комментарий"
ElseIf K = 18 And Range("R" & R).Value <> "" Then
Range("AA" & R).Select
ElseIf K = 18 And Range("R" & R).Value <> "" Then
MsgBox "заполни другой комментарий"
'ElseIf ... And ... Then
' K2 = ...
' Ofs = ...
'ColCnt = ..
Else
Exit Sub
End If

With Target.Parent.Cells(R, K2)
' Возможно, ссылка на родительский элемент лишняя (и даже вредна), и корректно будет работать
' обращение к Cells() без указания контекста. Не проверял.
If .Value2 = "" Then ' если значение ячейки в соответствующем столбце пустое
' очистить соответствующий диапазон
.Offset(0, ColOfs).Resize(, ColCnt).ClearContents

End If

End With



End Sub




просьба помочь - хочу добавить следующее дополнение в текст программы:
если ячейка G заполняется (т.е. не пустая) в одном из ряду, то курсор должен позиционироваться на ячейке O в томже ряду и должно выходить сообщение "ввeдите комментарий", тоже самое когда ячейка G заполняется (т.е. не пустая) в одном из ряду, то курсор должен позиционироваться на ячейке AA в соответсвующем ряду и должно выходить сообщение "введите другой комментарий"
это я в приведенном тексте прописал, но в результате макрос только позиционирует курсор в нужную ячейку, но сообщение просьбой ввести комментарий не выходит и дальше выходит ошибкА Run time error 1004, что м.б. не так (пример во вложении)?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.05.2012, 14:22
    #37784501
скукотища
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
martinezo,

Код: vbnet
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.
' прочитайте раздел справки по конструкции IF ELSE
ElseIf K >= 23 And K <= 27 Then ' столбцы W:AA
  K2 = 18 ' номер столбца R
  ColOfs = 5 ' расстояние от столбца R до столбца W
  ColCnt = 5 ' количество столбцов в диапазоне W:AA
ElseIf K = 7 And Range("G" & R).Value <> "" Then
  Range("O" & R).Select
''''''ElseIf K = 7 And Range("G" & R).Value <> "" Then  ' <-- это условие уже проверялось двумя строками выше
  MsgBox "заполни комментарий"
  Exit Sub
ElseIf K = 18 And Range("R" & R).Value <> "" Then
  Range("AA" & R).Select
''''''ElseIf K = 18 And Range("R" & R).Value <> "" Then  ' <-- это условие уже проверялось
  MsgBox "заполни другой комментарий"
  Exit Sub
'ElseIf ... And ... Then
' K2 = ...
' Ofs = ...
'ColCnt = ..
Else
  Exit Sub
End If

' runtime error '1004' получали на строке 
'                        .Offset(0, ColOfs).Resize(, ColCnt).ClearContents
' из-за того, что при выполнении условия K = 7 And Range("G" & R).Value <> "" 
' не присваивалось значение ColCnt и метод Resize обоснованно но невнятно ругался
' чтобы этого избежать добавлены два выхода из процедуры ( строки выделены цветом )
' PS: откройте для себя точки останова и пошаговое выполнение кода
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
06.05.2012, 18:14
    #37784643
martinezo
martinezo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
спасибо Вам за отзывчивость и наступающим Днем Победы!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.05.2012, 13:54
    #37787815
martinezo
martinezo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
скукотищаmartinezo,

Код: vbnet
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.
' прочитайте раздел справки по конструкции IF ELSE
ElseIf K >= 23 And K <= 27 Then ' столбцы W:AA
  K2 = 18 ' номер столбца R
  ColOfs = 5 ' расстояние от столбца R до столбца W
  ColCnt = 5 ' количество столбцов в диапазоне W:AA
ElseIf K = 7 And Range("G" & R).Value <> "" Then
  Range("O" & R).Select
''''''ElseIf K = 7 And Range("G" & R).Value <> "" Then  ' <-- это условие уже проверялось двумя строками выше
  MsgBox "заполни комментарий"
  Exit Sub
ElseIf K = 18 And Range("R" & R).Value <> "" Then
  Range("AA" & R).Select
''''''ElseIf K = 18 And Range("R" & R).Value <> "" Then  ' <-- это условие уже проверялось
  MsgBox "заполни другой комментарий"
  Exit Sub
'ElseIf ... And ... Then
' K2 = ...
' Ofs = ...
'ColCnt = ..
Else
  Exit Sub
End If

' runtime error '1004' получали на строке 
'                        .Offset(0, ColOfs).Resize(, ColCnt).ClearContents
' из-за того, что при выполнении условия K = 7 And Range("G" & R).Value <> "" 
' не присваивалось значение ColCnt и метод Resize обоснованно но невнятно ругался
' чтобы этого избежать добавлены два выхода из процедуры ( строки выделены цветом )
' PS: откройте для себя точки останова и пошаговое выполнение кода



Уважаемые форумчане, прошу помочь, возникла следующая непонятная для меня ситуация: у меня макрос на компе работает корректно, но когда этот же файл открыл мой коллега у себя на компе, у него стал вылетать Excel при срабатывании макроса, а именно, при условии когда ячейка G пустая, при попытке что-либо написать в ячейках K:P макрос должен все удалить, в этот момент файл вылетает,тоже самое когда ячейка R пустая. Полагаю, что у меня макрос срабатывает нормально тк у меня новый ПК, а у коллеги не очень, поэтому наверняка проблема будет и других пользователей, попробовал поискать про это в Инете - пишут что возможно неккоректно описаны переменные, но что именно не понятно. Спасибо за ответ
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.05.2012, 17:56
    #37788276
martinezo
martinezo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
условия в процедуре Worksheet_Change
причем, у меня windows 7 офис 2010 а у коллеги XP и офис 2010 - но у него закрывается Эксель при срабатывании макроса,
запускал пошаговую отладку - макрос срабатывает корректно и файл не вылетает, в чем м.б. дело (файл во вложении)?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / условия в процедуре Worksheet_Change / 12 сообщений из 12, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 432ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2157804]:
 0ms
get settings:
 8ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 33ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 41ms
get tp. blocked users:
 1ms
others: 318ms
total:  432ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]