Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Счет суммы ячеек с заливкой: переделать функцию пользователя в отдельную процедуру
 
#1
09.02.2018 10:13:07
Есть функция, взята с Планеты:
Код
?
1
2
3
4
5
6
7
8
9
10
11
Public Function SumByColor(DataRange As Range, ColorSample As Range) As Double
     Dim Sum As Double
     Application.Volatile True
  
     For Each cell In DataRange
         If cell.Interior.Color = ColorSample.Interior.Color Then
             Sum = Sum + cell.Value
         End If
     Next cell
     SumByColor = Sum
 End Function
работает, все отлично. Ее надо перенести в макрос.
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub SumByColor()
     Dim rData As Range
     Dim cellRefColor As Range
     Dim Sum, SumByColor As Double
     Dim indRefColor As Long
     Dim cellCurrent As Range
     rData = InputBox("Âûáåðèòå ñòîëáåö ñóììèðîâàíèÿ.")
     cellRefColor = InputBox("Âûáåðèòå ÿ÷åéêó ñ öâåòîì, ïî êîòîðîìó áóäåò ñóììèðîâàíèå")
     indRefColor = cellRefColor.Cells(1, 1).Interior.Color
  
     Application.Volatile True
     For Each ñellCurrent In rData
         If indRefColor = ñellCurrent.Interior.Color Then
             Sum = WorksheetFunction.Sum(cellCurrent, Sum)
         End If
     Next cellCurrent
     ActiveCell.Value = Sum
  
End Sub
Ругается на цикл, хотя я его не трогал, говорит invalid next control variable reference, помогите пожалуйста
Изменено: bortnik27 - 09.02.2018 14:40:17
 
 
 
#2
09.02.2018 10:17:39
Какая же это функция!? Это и так макрос.
В 12-й строке замените ñellCurrent на cellCurrent. Вероятно русская С (эс) вместо аглицкой C (цэ)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
09.02.2018 10:21:03
bortnik27, включайте RU-раскладку при копировании кода в тему.
А OPTION EXPLICIT избавил бы от трабла в момент зачатия.
 
 
 
#4
09.02.2018 10:21:40
Я где-то на другом форуме тоже написал свой комментарий :)
Или на этом? Не помню...
Но могу повторить - этот код вообще не работает, даже до цикла не доходит. Инпутбоксы не те.
Изменено: Hugo - 09.02.2018 10:25:36
 
 
 
#5
09.02.2018 10:40:01
Hugo, вроде на этом))
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#6
09.02.2018 10:44:29
Блин :)
 
 
 
#7
09.02.2018 10:54:06
Sanja, вот это подстава, спасибо исправил
Hugo, Да вы отвечали в ветке на другу тему, думаю лучше макрос обсуждать здась. Спасибо, я уже учел ваше замечание.
Сейчас код выглядит так:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub SumByColor()
     Dim rData As Range
     Dim cellRefColor As Range
     Dim Sum, SumByColor As Double
     Dim indRefColor As Long
     Dim cellCurrent As Range
     rData = Application.InputBox("Âûáåðèòå ñòîëáåö ñóììèðîâàíèÿ.", Type:=8)
     cellRefColor = Application.InputBox("Âûáåðèòå ÿ÷åéêó ñ öâåòîì, ïî êîòîðîìó áóäåò ñóììèðîâàíèå", Type:=8)
     indRefColor = cellRefColor.Cells(1, 1).Interior.Color
   
     Application.Volatile True
     For Each cellCurrent In rData
         If indRefColor = cellCurrent.Interior.Color Then
             Sum = WorksheetFunction.Sum(cellCurrent, Sum)
         End If
     Next cellCurrent
     ActiveCell.Value = Sum
Но получаю ошибку 91 Object variable or With block variable not set" в строке rData = Application.InputBox
 
 
 
#8
09.02.2018 10:55:58
Цитата
bortnik27 написал:
variable not set
- это ведь объект, нужно
Код
?
1
set rdata = ....
 
 
 
#9
09.02.2018 10:57:27
bortnik27,
Цитата
SET rData =...
ВКЛЮЧАЙТЕ  RU-раскладку :evil:  
 
 
 
#10
09.02.2018 11:46:44
Апострофф, я не понимаю что вы от меня хотите
Hugo, огонь! работает) Спасибо!
А можно как-то вставлять в ячейку функцию по кнопке надстройки? т.е. у меня сейчас своя надстройка, в ней есть функции которые появляются после знака равно по имени, а есть макросы которые срабатывают по кнопка в панели, но если на кнопку "посадить" функцию она не срабатывает, можно ли вызывать по кнопке функцию в ячейку?  
 
 
 
#11
09.02.2018 13:05:01
название темы:
в заданном диапазоне посчитать сумму ячеек, имеющих указанную заливку.

даже когда указаны правильные типы Инпутбоксов, пользователь вдруг передумает (обломится) что-то считать, нажмет Esc и все рухнет по ошибке
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#12
09.02.2018 13:31:43
Ігор Гончаренко, Вы имеете в виду что стоит убрать окошко ошибки?
 
 
 
#13
09.02.2018 13:47:12
ни в коем случае.
окошки (запросы на выбор диапазонов) нужны чтобы можно было задать условия, по которым собственно работает макрос
если этот макрос написан для себя - то и так сойдет
а если будет пользоваться еще кто-то, то для посторонних - это шок, когда макрос вывалился по ошибке, и потом еще окно с вопросом и нужно выбрать нажать Debug или Cancеl, и если случайно выбрал Debug - то это следующее окно с вообще непостижимым содержанием и это следующая порция шока! все это не гуманно по отношению к пользователям и незначительными исправлениями кода от всего этого можно избавиться.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#14
09.02.2018 14:26:07
Цитата
Ігор Гончаренко написал:
когда макрос вывалился по ошибке, и потом еще окно с вопросом и нужно выбрать нажать Debug или Cancеl,
Вот, я об этом окошке, буду крайне признателен если скажете как это можно организовать.
 
 
 
#15
09.02.2018 15:44:37
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub SumByColor()
     Dim rData As Range
     Dim cellRefColor As Range
     Dim Sum, SumByColor As Double
     Dim indRefColor As Long
     Dim cellCurrent As Range
     on error resume next
     set rData = Application.InputBox("Âûáåðèòå ñòîëáåö ñóììèðîâàíèÿ.", Type:=8)
     set cellRefColor = Application.InputBox("Âûáåðèòå ÿ÷åéêó ñ öâåòîì, ïî êîòîðîìó áóäåò ñóììèðîâàíèå", Type:=8)
     if err then exit sub
     on error goto 0
     indRefColor = cellRefColor.Cells(1, 1).Interior.Color
    
     Application.Volatile True
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#16
12.02.2018 09:57:54
Ігор Гончаренко, Спасибо большое!
 
 
 
Страницы: 1
Читают тему
Loading...