Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.87/15: Рейтинг темы: голосов - 15, средняя оценка - 4.87
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
1

Ошибка в макросе условия

06.06.2015, 19:59. Просмотров 2864. Ответов 36
Метки нет (Все метки)

Помогите найти ошибку в макросе
Visual Basic
1
2
3
            If Range("B" & i).Value = Empty And If Range("C" & i).Value = Empty Then
            Range(Cells(i, 6), Cells(i, 26)) = Empty
            End If
не работает. но если его упростить до...
Visual Basic
1
2
3
            If Range("B" & i).Value = Empty Then
            Range(Cells(i, 6), Cells(i, 26)) = Empty
            End If
то все нормально
0
QA
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
06.06.2015, 19:59
Ответы с готовыми решениями:

Пауза в макросе до выполнения определенного условия
Добрый вечер! Кросс-пост:...

Как изменить условия закрашивания фигуры в макросе
Имеется файл excel ,как изменить условия закрашивания фигуры?Не могу разобраться в макросе Условие...

Как написать условия в макросе так, чтобы диаграмма не меняла своего типа
Друзья. Задача такая, у меня есть макрос: For i = 1 To 65000 If...

Ошибка в макросе
Добрый вечер. Подскажите, пожалуйста, как устранить ошибку в макросе. Подключаюсь к базе,...

Ошибка в макросе
Помогите, пожалуйста, определить ошибку в макросе и исправить ее. Sub ÔÓ() Dim I As Integer ...

36
Vovchikvsb
464 / 121 / 61
Регистрация: 04.03.2015
Сообщений: 324
07.06.2015, 20:41 21
Цитата Сообщение от Оксана33 Посмотреть сообщение
подскажите, пож., как исправить ваш макрос, чтоб это работало для каждой строки колонок А, B и С?
Если нужно проверить все 3 колонки, то можно так
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Sub test()
    Dim mas(), temp, IfEmpty As Boolean
    mas = Range("A:C").Value
    IfEmpty = True
    For Each temp In mas
        If temp <> Empty Then
            IfEmpty = False
            Exit For
        End If
    Next temp
    If IfEmpty Then MsgBox ("Пусто") Else MsgBox ("Не пусто")
End Sub
Добавлено через 54 минуты
Вариант без цикла
Visual Basic
1
2
3
4
5
Sub test2()
    If Intersect(ActiveSheet.UsedRange, Range("A:C")) Is Nothing _
    Or (ActiveSheet.UsedRange.Address(0, 0) = "A1" And Range("A1").Value = Empty) _
    Then MsgBox ("Пусто") Else MsgBox ("Не пусто")
End Sub
Если проверяемый диапазон не включает ячейку A1, или лист 100% не пустой, то можно сократить до
Visual Basic
1
2
3
Sub test3()
    If Intersect(ActiveSheet.UsedRange, Range("A:C")) Is Nothing Then MsgBox ("Пусто") Else MsgBox ("Не пусто")
End Sub
1
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
07.06.2015, 22:53  [ТС] 22
спасибо

Добавлено через 1 час 56 минут
Цитата Сообщение от Hugo121 Посмотреть сообщение
Если как перебрать - подсказал. Если всё в целом - то что?
но если перебрать, то этот код нужно 100 раз вписать, а нельзя ли переменную использовать?
у меня таблица из 100 строк, где заполнены колонки от B до F
и если нет текста в ячейках (от В до F) строки, то эта строка должна быть очищена от заливки (и для убедительности мне нужна не одна ячейка, чтобы не ошибиться)
0
Hugo121
6434 / 2495 / 447
Регистрация: 19.10.2012
Сообщений: 7,444
08.06.2015, 00:34 23
Цитата Сообщение от Оксана33 Посмотреть сообщение
но если перебрать, то этот код нужно 100 раз вписать, а нельзя ли переменную использовать?
Range("B" & i).Value - это кто писал?
0
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
08.06.2015, 10:45  [ТС] 24
но этот способ не позволяет выбрать диапазон
0
08.06.2015, 10:45
Hugo121
6434 / 2495 / 447
Регистрация: 19.10.2012
Сообщений: 7,444
08.06.2015, 11:05 25
Почему это не позволяет? Определили диапазон, определили пределы для i, сделали цикл.
Вы показываете обрывки кода, без файла и задачи - не ждите рабочего решения для непонятно чего...
1
Vovchikvsb
464 / 121 / 61
Регистрация: 04.03.2015
Сообщений: 324
08.06.2015, 18:08 26
Лучший ответ Сообщение было отмечено Оксана33 как решение

Решение

Цитата Сообщение от Оксана33 Посмотреть сообщение
у меня таблица из 100 строк, где заполнены колонки от B до F
и если нет текста в ячейках (от В до F) строки, то эта строка должна быть очищена от заливки
Visual Basic
1
2
3
4
5
6
7
8
9
Sub test()
    Dim i As Integer, j As Integer
    For i = 1 To Range("A1").SpecialCells(xlCellTypeLastCell).Row
        For j = 2 To 6
            If Not Cells(i, j).Value = Empty Then Exit For
        Next j
        If j = 7 Then Range(i & ":" & i).Interior.Pattern = xlNone
    Next i
End Sub
Надеюсь, что это то, что нужно.
Очищает заливку во всей строке, если ячейки с B до F чистые. Если хотя бы в одной есть что-то, то макрос ничего со строкой не делает.
1
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
09.06.2015, 12:53  [ТС] 27
Добавлено через 9 минут
Цитата Сообщение от Hugo121 Посмотреть сообщение
Вы показываете обрывки кода, без файла и задачи - не ждите рабочего решения для непонятно чего...
вот файл...
https://cloud.mail.ru/public/BWu2/AjwGyv9AJ
это событие листа ПРИМЕР

Добавлено через 2 минуты
Цитата Сообщение от Vovchikvsb Посмотреть сообщение
Очищает заливку во всей строке, если ячейки с B до F чистые. Если хотя бы в одной есть что-то, то макрос ничего со строкой не делает.
Спасибо за ответ!
Подскажите, пожалуйста, как добавить еще и ClearContents
0
Hugo121
6434 / 2495 / 447
Регистрация: 19.10.2012
Сообщений: 7,444
09.06.2015, 13:04 28
Цитата Сообщение от Оксана33 Посмотреть сообщение
как добавить еще и ClearContents
Зачем? Т.е. если в строке ничего нет - то это ничего убрать?
А на облако например мне с работы толку нет ходить.
0
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
09.06.2015, 13:53  [ТС] 29
Цитата Сообщение от Hugo121 Посмотреть сообщение
Зачем? Т.е. если в строке ничего нет - то это ничего убрать?
нет, строка заполнена частично, но впрочем уже не важно

Добавлено через 7 минут
Цитата Сообщение от Vovchikvsb Посмотреть сообщение
Очищает заливку во всей строке, если ячейки с B до F чистые
а если есть данные в ячейке Z, как их удалить?
0
Vovchikvsb
464 / 121 / 61
Регистрация: 04.03.2015
Сообщений: 324
10.06.2015, 01:20 30
Лучший ответ Сообщение было отмечено Оксана33 как решение

Решение

Цитата Сообщение от Оксана33 Посмотреть сообщение
Подскажите, пожалуйста, как добавить еще и ClearContents
Строку 7 замените на
Visual Basic
1
2
3
4
If j = 7 Then
    Range(i & ":" & i).Interior.Pattern = xlNone
    Range(i & ":" & i).ClearContents
End If
1
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
10.06.2015, 11:24  [ТС] 31
Цитата Сообщение от Vovchikvsb Посмотреть сообщение
Строку 7 замените на
да, я это уже пробовала, только не в модуле а в событии листа Private Sub Worksheet_Change(ByVal Target As Range), но почему-то там он не хочет работать. как отдельный макрос - да, но как событие листа -нет. разве есть исключения для событий листа?
0
Vovchikvsb
464 / 121 / 61
Регистрация: 04.03.2015
Сообщений: 324
10.06.2015, 21:14 32
Цитата Сообщение от Оксана33 Посмотреть сообщение
да, я это уже пробовала, только не в модуле а в событии листа Private Sub Worksheet_Change(ByVal Target As Range), но почему-то там он не хочет работать. как отдельный макрос - да, но как событие листа -нет. разве есть исключения для событий листа?
Дело, скорее всего, в другом.
Подозреваю, что вы попали на цикл событий.
Вставьте эту строчку в начало процедуры события.
Visual Basic
1
If MsgBox("Продолжить?", vbOKCancel) = vbOK Then Range("A1").ClearContents
Если вопрос будет повторяться, то у вас цикл событий и нужно что-то менять.
0
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
11.06.2015, 16:35  [ТС] 33
Цитата Сообщение от Vovchikvsb Посмотреть сообщение
Если вопрос будет повторяться, то у вас цикл событий и нужно что-то менять
Да, именно так и получается. Выходит, что событие цепляет за собой новое событие и так до бесконечности?
0
Vovchikvsb
464 / 121 / 61
Регистрация: 04.03.2015
Сообщений: 324
12.06.2015, 00:29 34
Цитата Сообщение от Оксана33 Посмотреть сообщение
Выходит, что событие цепляет за собой новое событие и так до бесконечности?
Именно. Так что придется вам как-то изменять процедуру. Как вариант, использовать флаг.
Если выложите полный код процедуры события, то напишу как.
0
Оксана33
1 / 1 / 0
Регистрация: 03.12.2014
Сообщений: 268
14.06.2015, 20:00  [ТС] 35
Цитата Сообщение от Vovchikvsb Посмотреть сообщение
Если выложите полный код процедуры события, то напишу как.
...если Вам не трудно

Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveCell.Column = 1 Then

Dim i As Long
i = Target.Row

If Not Intersect(Target, Range("A" & i)) Is Nothing Then

'ЕСЛИ ПРАВИЛЬНО
If Range("A" & i).Value = Range("B" & i).Value Then
Range("Z" & i).Value = Range("Z" & i).Value + 1
End If

'УДАЛЕНИЕ СОДЕРЖИМОГО и УСТАНОВКА УРОВНЯ 1
If Cells(i, 1) = "," Or Cells(i, 1) = "." Then

'удаление содержимого
Columns("A:A").Select
Selection.ClearContents

'установка уровня
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Range("A1").Select
End If

'СОРТИРОВКА КОЛОНКИ Z
If Cells(i, 1) = "1" Then

'удаление содержимого ячейки А
Cells(i, 1).Select
Selection.ClearContents

'коретировка содержимого ячейки Z
'Range("Z" & i).Value = Range("Z" & i).Value + 0

'сортировка диапазона
Columns("A:Z").Select
Range("Z1").Activate
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"Z1:Z1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A1:Z1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End If

'ПОВЫСИТЬ СТЕПЕНЬ
If Cells(i, 1) = "+" Then
Range("Z" & i).Value = Range("Z" & i).Value + 2
ElseIf Cells(i, 1) = 2 Then
Range("Z" & i).Value = Range("Z" & i).Value + 3
ElseIf Cells(i, 1) = 3 Then
Range("Z" & i).Value = Range("Z" & i).Value + 4
ElseIf Cells(i, 1) = 4 Then
Range("Z" & i).Value = Range("Z" & i).Value + 5
ElseIf Cells(i, 1) = 5 Then
Range("Z" & i).Value = Range("Z" & i).Value + 6
End If

'ПОНИЗИТЬ СТЕПЕНЬ
If Cells(i, 1) = "-" Or Cells(i, 1) = "\" Then
Range("Z" & i).Value = Range("Z" & i).Value - 0
ElseIf Cells(i, 1) = -2 Or Cells(i, 1) = "\2" Then
Range("Z" & i).Value = Range("Z" & i).Value - 1
ElseIf Cells(i, 1) = -3 Or Cells(i, 1) = "\3" Then
Range("Z" & i).Value = Range("Z" & i).Value - 2
ElseIf Cells(i, 1) = -4 Or Cells(i, 1) = "\4" Then
Range("Z" & i).Value = Range("Z" & i).Value - 3
ElseIf Cells(i, 1) = -5 Or Cells(i, 1) = "\5" Then
Range("Z" & i).Value = Range("Z" & i).Value - 4
End If

'ЕСЛИ НОЛЬ И ЕСЛИ НЕ ПРАВИЛЬНО
If Cells(i, 1) = 0 Then
Range("Z" & i).Value = Range("Z" & i).Value + 0
ElseIf Range("A" & i).Value <> Range("B" & i).Value Then
Range("Z" & i).Value = Range("Z" & i).Value - 1
End If

'ЗАЛИВКА СТРОКИ (0-Й СТЕПЕНИ)
If Range("Z" & i).Value = 0 Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Color = RGB(218, 238, 243) 'ГОЛУБОЙ
Else: Range(Cells(i, 6), Cells(i, 26)).Interior.Pattern = xlNone
End If

'ЗАЛИВКА СТРОКИ НИЖЕ НУЛЯ
If Range("Z" & i).Value < 0 Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Color = RGB(228, 223, 236) 'ЛИЛОВЫЙ
'Else: Range(Cells(i, 6), Cells(i, 26)).Interior.Color = RGB(218, 238, 243) 'ГОЛУБОЙ
End If

'ЕСЛИ СТРОКА ПУСТАЯ - УДАЛИТЬ ГРАДАЦИЮ И ЗАЛИВКУ ???????????
If Range("Z" & i).Value = 1 And Range("F" & i).Value = Empty Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Pattern = xlNone
Range("Z" & i).ClearContents

ElseIf Range("Z" & i).Value = 0 And Range("F" & i).Value = Empty Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Pattern = xlNone
Range("Z" & i).ClearContents
End If

End If
End If
End Sub
0
Hugo121
6434 / 2495 / 447
Регистрация: 19.10.2012
Сообщений: 7,444
14.06.2015, 20:05 36
Если этот код изменяет ячейки на этом же листе - то перед всеми изменениями ставьте application.enableevents=false, после всего - application.enableevents=true
Только помните, что если в процессе отладки (или работы) код после отключения событий выпадет в ошибку - то события так и останутся отключенными, пока их не включите (кодом или из окна отладки тоже кодом), или не перезапустите Эксель.
0
Vovchikvsb
464 / 121 / 61
Регистрация: 04.03.2015
Сообщений: 324
14.06.2015, 23:08 37
Если нужно отслеживать только одно событие (возможно, что на остальные нужно реагировать), то можно так.
Visual Basic
1
2
3
4
5
6
7
8
Dim flag As Boolean
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If flag Then Exit Sub
    flag = True
    'здесь поместите код вашей процедуры
    flag = False
End Sub
Вот полный код вашей процедуры
Кликните здесь для просмотра всего текста
Visual Basic
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Dim flag As Boolean
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If flag Then Exit Sub
    flag = True
    
    If ActiveCell.Column = 1 Then
 
Dim i As Long
i = Target.Row
 
If Not Intersect(Target, Range("A" & i)) Is Nothing Then
 
'ЕСЛИ ПРАВИЛЬНО
If Range("A" & i).Value = Range("B" & i).Value Then
Range("Z" & i).Value = Range("Z" & i).Value + 1
End If
 
'УДАЛЕНИЕ СОДЕРЖИМОГО и УСТАНОВКА УРОВНЯ 1
If Cells(i, 1) = "," Or Cells(i, 1) = "." Then
 
'удаление содержимого
Columns("A:A").Select
Selection.ClearContents
 
'установка уровня
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Range("A1").Select
End If
 
'СОРТИРОВКА КОЛОНКИ Z
If Cells(i, 1) = "1" Then
 
'удаление содержимого ячейки А
Cells(i, 1).Select
Selection.ClearContents
 
'коретировка содержимого ячейки Z
'Range("Z" & i).Value = Range("Z" & i).Value + 0
 
'сортировка диапазона
Columns("A:Z").Select
Range("Z1").Activate
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
"Z1:Z1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A1:Z1000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End If
 
'ПОВЫСИТЬ СТЕПЕНЬ
If Cells(i, 1) = "+" Then
Range("Z" & i).Value = Range("Z" & i).Value + 2
ElseIf Cells(i, 1) = 2 Then
Range("Z" & i).Value = Range("Z" & i).Value + 3
ElseIf Cells(i, 1) = 3 Then
Range("Z" & i).Value = Range("Z" & i).Value + 4
ElseIf Cells(i, 1) = 4 Then
Range("Z" & i).Value = Range("Z" & i).Value + 5
ElseIf Cells(i, 1) = 5 Then
Range("Z" & i).Value = Range("Z" & i).Value + 6
End If
 
'ПОНИЗИТЬ СТЕПЕНЬ
If Cells(i, 1) = "-" Or Cells(i, 1) = "\" Then
Range("Z" & i).Value = Range("Z" & i).Value - 0
ElseIf Cells(i, 1) = -2 Or Cells(i, 1) = "\2" Then
Range("Z" & i).Value = Range("Z" & i).Value - 1
ElseIf Cells(i, 1) = -3 Or Cells(i, 1) = "\3" Then
Range("Z" & i).Value = Range("Z" & i).Value - 2
ElseIf Cells(i, 1) = -4 Or Cells(i, 1) = "\4" Then
Range("Z" & i).Value = Range("Z" & i).Value - 3
ElseIf Cells(i, 1) = -5 Or Cells(i, 1) = "\5" Then
Range("Z" & i).Value = Range("Z" & i).Value - 4
End If
 
'ЕСЛИ НОЛЬ И ЕСЛИ НЕ ПРАВИЛЬНО
If Cells(i, 1) = 0 Then
Range("Z" & i).Value = Range("Z" & i).Value + 0
ElseIf Range("A" & i).Value <> Range("B" & i).Value Then
Range("Z" & i).Value = Range("Z" & i).Value - 1
End If
 
'ЗАЛИВКА СТРОКИ (0-Й СТЕПЕНИ)
If Range("Z" & i).Value = 0 Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Color = RGB(218, 238, 243) 'ГОЛУБОЙ
Else: Range(Cells(i, 6), Cells(i, 26)).Interior.Pattern = xlNone
End If
 
'ЗАЛИВКА СТРОКИ НИЖЕ НУЛЯ
If Range("Z" & i).Value < 0 Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Color = RGB(228, 223, 236) 'ЛИЛОВЫЙ
'Else: Range(Cells(i, 6), Cells(i, 26)).Interior.Color = RGB(218, 238, 243) 'ГОЛУБОЙ
End If
 
'ЕСЛИ СТРОКА ПУСТАЯ - УДАЛИТЬ ГРАДАЦИЮ И ЗАЛИВКУ ???????????
If Range("Z" & i).Value = 1 And Range("F" & i).Value = Empty Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Pattern = xlNone
Range("Z" & i).ClearContents
 
ElseIf Range("Z" & i).Value = 0 And Range("F" & i).Value = Empty Then
Range(Cells(i, 6), Cells(i, 26)).Interior.Pattern = xlNone
Range("Z" & i).ClearContents
End If
 
End If
End If
 
    
    flag = False
End Sub
0
14.06.2015, 23:08
Answers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
14.06.2015, 23:08

Ошибка в Макросе
Написал Макрос Sub AfterMarket() 'Rows(&quot;1:1&quot;).Select 'Selection.Delete Shift:=xlUp...

Ошибка в макросе
Добрый день, Подскажите где ошибка в моем макросе

Где ошибка в макросе?
Macros: Sub ExcelReport() Dim ExcelSheet As Object Set ExcelSheet =...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
37
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.