условия в процедуре Worksheet_Change / Visual Basic

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / условия в процедуре Worksheet_Change

12 сообщений из 12, страница 1 из 1

условия в процедуре Worksheet_Change

#37782599

martinezo

Гость

Здравствуйте, форумчане, прошу помочь разобраться начинающему программисту с работой в процедуре
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

04.05.2012, 17:50

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37783144

скукотища

Гость

Код: 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:10

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37783161

катастрофа

Участник

Сообщения: 2 519

Рейтинг: 0 / 0

скукотища,
ElseIf If K >= 23 And K <= 27 Then ' столбцы W:AA - червоная строка, ересь?

...

Рейтинг:

0 / 0

05.05.2012, 09:20

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37783244

скукотища

Гость

катастрофаскукотища,
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:35

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37783274

martinezo

Гость

катастрофаскукотища,
ElseIf If K >= 23 And K <= 27 Then ' столбцы W:AA - червоная строка, ересь?

Спасибо, только один If (второй) лишний

...

Рейтинг:

0 / 0

05.05.2012, 10:58

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37783287

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.
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:07

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37783306

скукотища

Гость

> 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, 11:18

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37784000

martinezo

Гость

текст программы
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

05.05.2012, 17:14

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37784501

скукотища

Гость

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, 14:22

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37784643

martinezo

Гость

спасибо Вам за отзывчивость и наступающим Днем Победы!

...

Рейтинг:

0 / 0

06.05.2012, 18:14

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37787815

martinezo

Гость

скукотища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, 13:54

| Ответить | Цитировать | Написать

условия в процедуре Worksheet_Change

#37788276

martinezo

Гость

причем, у меня windows 7 офис 2010 а у коллеги XP и офис 2010 - но у него закрывается Эксель при срабатывании макроса,
запускал пошаговую отладку - макрос срабатывает корректно и файл не вылетает, в чем м.б. дело (файл во вложении)?

...

Рейтинг:

0 / 0

10.05.2012, 17:56

| Ответить | Цитировать | Написать

12 сообщений из 12, страница 1 из 1

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / условия в процедуре Worksheet_Change

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=60&fpage=79&tid=2157804]:	0ms
get settings:	10ms
get forum list:	15ms
check forum access:	4ms
check topic access:	4ms
track hit:	30ms
get topic data:	13ms
get forum data:	3ms
get page messages:	69ms
get tp. blocked users:	2ms
others:	17ms

total:	167ms