Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
zhigalkin_p
0 / 0 / 0
Регистрация: 26.10.2017
Сообщений: 37
#1

Суммирование значений в смещенном диапазоне - VBA

04.01.2018, 00:24. Просмотров 181. Ответов 9
Метки нет (Все метки)

Доброго времени суток, уважаемые форумчане!
Прошу опять вашей помощи.
Имеется код:
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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
            
Dim rngChek As Range
Dim x As Integer
Dim rngChekRange As Range
ActiveSheet.Unprotect
    Set rngChekRange = Range("$K$3")
For x = 1 To 30
    Set rngChekRange = Union(rngChekRange, Range("$K$3").Offset(0, 13 * x))
Next x
If Intersect(Target, rngChekRange) Is Nothing Then
    'ActiveSheet.Protect
    Exit Sub
Else
    Set rngChek = Intersect(Target, rngChekRange)
End If
    Cancel = True
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                
    ''------------------------------- Вот тут загвоздка -------------------------
    ' Это изначальная формула на явные ячейки =IFERROR(IF((SUM(J5:O11)/(COUNTA(J5:O11)/6))=S17,""Все правильно"",""Неверно""),""Нет категорий!"")"
    ' Хочу ее заменить на ячейки, смещенные относительно K3, т.е. нужно в S17 чтобы вставлялась формула, только брала значения относительно K3.
    '
           
                'rngChek.EntireColumn.Offset(0, 5).Cells(21, 1).Formula = "=IFERROR(IF((SUM(ActiveCell.Offset(2, -1):ActiveCell.Offset(8, 4)))/(COUNTA(rngChek.Offset(2, -1):rngChek.Offset(8, 4))/6))=rngChek.Offset(14, 8).Value,""Все правильно"",""Неверно""),""Нет категорий!"")"
rngChek.EntireColumn.Offset(0, 5).Cells(21, 1).Formula = "=SUM(rngChek.Offset(2, -1), rngChek.Offset(8, 4))"
                'rngChek.EntireColumn.Offset(0, 1).Cells(17, 1).Value + rngChek.Offset(0, -1).Value
            
 '' ---------------------------------- Тут пока конец ---------------------------
            Else
                Target = vbNullString
                'Target = "r"
                'rngObj.Offset(0, -4).Resize(1, 3).Interior.Pattern = xlNone
                rngChek.EntireColumn.Offset(0, 5).Cells(21, 1).Value = "111"  'rngChek.EntireColumn.Offset(0, 1).Cells(17, 1).Value - rngChek.Offset(0, -1).Value
            End If
 
             
Set rngChek = Nothing
Set rngChekRange = Nothing
'ActiveSheet.Protect
End Sub
Помогите реализовать, пожалуйста.
P.S. Макрос срабатывает на ячейке К3 и так далее через 13 ячеек.
Файл прикладываю, (фрагмент)
0
Вложения
Тип файла: rar пример.rar (23.0 Кб, 2 просмотров)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
04.01.2018, 00:24
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Суммирование значений в смещенном диапазоне (VBA):

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

VBA суммирование в диапазоне
Как, через Userform можно сделать подсчет количества названий в таблице с...

Суммирование инструментами VBA ячеек в диапазоне, выделенных определенным цветом
Как инструментами VBA суммировать отдельные ячейки в диапазоне, которые...

Суммирование значений времени
Здравствуйте! Возникла сложность при суммировании значений времени. Программно...

Суммирование значений в массиве макросом
Здраствуйте. Помогите с такой задачкой. Есть массив повторяемых значений, где...

Суммирование одинаковых значений таблицы
Имеется таблица с несколькими столбцами Руководитель, договор, абонент,...

9
zhigalkin_p
0 / 0 / 0
Регистрация: 26.10.2017
Сообщений: 37
04.01.2018, 07:45  [ТС] #2
Неужели никто не в силах помочь?
0
Dinoxromniy
391 / 198 / 61
Регистрация: 22.12.2015
Сообщений: 583
04.01.2018, 08:29 #3
Цитата Сообщение от zhigalkin_p Посмотреть сообщение
Неужели никто не в силах помочь?
Это шутка юмора? Вопрос когда задан:
Цитата Сообщение от zhigalkin_p Посмотреть сообщение
Сегодня, 00:24. Просмотров 42. Ответов 1
Полагаю, строчка должна быть построена по такой логике:
Visual Basic
1
rngChek.EntireColumn.Offset(0, 5).Cells(21, 1).Formula = "=SUM(" & rngChek.Offset(2, -1).Address & ", " & rngChek.Offset(8, 4).Address & ")"
0
zhigalkin_p
0 / 0 / 0
Регистрация: 26.10.2017
Сообщений: 37
04.01.2018, 08:59  [ТС] #4
Пробовал вот так:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
If Target = vbNullString Then
                Target = "a"
                'rngChek.Offset(9, -1).Range(Cells(, 1), Cells(, 6)).Value = "0"
                'rngChek.Offset(14, 3).Cells(, 1).Value = "0"
               For a = 1 To 7
                    For b = 1 To 6
                        rngChek.Offset(2, -1).Cells(, 1).Select
                        intSum = intSum + Cells(a, b)
                    Next
                Next
 
                rngChek.Offset(18, 5).Cells(, 1).Formula = "=IFERROR(IF(([B]intSum[/B]/(COUNTA(J5:O11)/6))=S17,""Все правильно"",""Неверно""),""Нет категорий!"")"
Выдает #ИМЯ

Уважаемый Dinoxromniy пробовал по вашему, что-то не получается....

Добавлено через 2 минуты
Т.е. получается, что intSum как-бы считает складывает значения, но в формуле они не участвуют...

Добавлено через 1 минуту
Ан, нет, выдает сумма ячеек ноль
0
Dinoxromniy
391 / 198 / 61
Регистрация: 22.12.2015
Сообщений: 583
04.01.2018, 09:00 #5
Цитата Сообщение от zhigalkin_p Посмотреть сообщение
что-то не получается....
zhigalkin_p, взял ваш файл, вставил в строку 31 вашего первого кода формулу из поста 3.
Результатом - при проставленной галочке в ячейке P21 устанавливается формула =СУММ($J$5; $O$11).
Какой результат нужен вам?
0
zhigalkin_p
0 / 0 / 0
Регистрация: 26.10.2017
Сообщений: 37
04.01.2018, 09:10  [ТС] #6
Мне надо, чтобы в ячейке P21 устанавливалась формула
Visual Basic
1
=IFERROR(IF((SUM(J5:O11)/(COUNTA(J5:O11)/6))=S17,""Все правильно"",""Неверно""),""Нет категорий!"")"
Но, если ее так и писать, то все работает нормально, а мне надо с циклом в 13 ячеек от K3.

Вы мне помогали ранее написать код
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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngObj As Range
Dim i As Integer
Dim rngObjRange As Range
ActiveSheet.Unprotect
Set rngObjRange = Range("$M$16:$M$24")
For i = 1 To 30
    Set rngObjRange = Union(rngObjRange, Range("$M$16:$M$24").Offset(0, 13 * i))
Next i
If Intersect(Target, rngObjRange) Is Nothing Then
    ActiveSheet.Protect
    Exit Sub
Else
    Set rngObj = Intersect(Target, rngObjRange)
End If
    Cancel = True
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                rngObj.Offset(0, -4).Resize(1, 3).Interior.Color = 5287936
                rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value = rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value + rngObj.Offset(0, -1).Value
            Else
                Target = vbNullString
                rngObj.Offset(0, -4).Resize(1, 3).Interior.Pattern = xlNone
                rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value = rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value - rngObj.Offset(0, -1).Value
            End If
    
Set rngObj = Nothing
Set rngObjRange = Nothing
ActiveSheet.Protect
End Sub
Теперь мне надо сделать такой же цикл для ячейки K3 (в которой ставится галочка), но только с формулой в P21
Visual Basic
1
=IFERROR(IF((SUM(J5:O11)/(COUNTA(J5:O11)/6))=S17,""Все правильно"",""Неверно""),""Нет категорий!"")"
так, чтобы
Visual Basic
1
(SUM(J5:O11)/(COUNTA(J5:O11)/6))=S17
было сделано через Offset относительно K3 (ну, по крайней мере, я так думаю надо сделать).
0
Dinoxromniy
391 / 198 / 61
Регистрация: 22.12.2015
Сообщений: 583
04.01.2018, 09:40 #7
Цитата Сообщение от zhigalkin_p Посмотреть сообщение
Теперь мне надо сделать такой же цикл для ячейки K3 (в которой ставится галочка), но только с формулой в P21
Visual BasicВыделить код
1
=IFERROR(IF((SUM(J5:O11)/(COUNTA(J5:O11)/6))=S17,""Все правильно"",""Неверно""),""Нет категорий!"")"
zhigalkin_p, тут какого рода проблема возникает: вы используете стиль ссылок вида А1. Я в нем вообще не разбираюсь: вот например что значит формула "=F12"? Не зная, в какую ячейку она вбита, нельзя сказать что она означает. Вобьешь в G12 - это ссылка на одну ячейку влево. Вобьешь ровно эту же формулу в E12 - это ссылка на одну ячейку вправо. А если в Е12 нужно получить ссылку на одну ячеку влево - нужно вбивать D12. Если это не идиотизм - что тогда нужно назвать идиотизмом? При этом в параллельно существует система нумерации R1C1, где относительная ссылка на одну ячейку влево всегда будет RC[-1], куда б ты ее не вбивал.
Применительно к вашему случаю - ваша формула будет одинакова для всех ячеек типа Р21, но у формулы нужно подобрать буковки. При этом в записи R1C1 эта формула ровно постоянна и звучит как
Код
=ЕСЛИОШИБКА(ЕСЛИ((СУММ(R[-16]C[-6]:R[-10]C[-1])/(СЧЁТ(R[-16]C[-6]:R[-10]C[-1])/6))=R[-4]C[3];"Все правильно";"Неверно");"Нет категорий!")
Никаких буковок подбирать не надо. Формула будет одна для всех ячеек.
Соответственно, весь вопрос сводится к тому, почему у вас в настройках не стоит галочка "использовать стиль ссылок R1C1", а в VBA коде вы пользуете свойство .Formula а не свойство .FormulaR1C1? В чем преимущество?
1
zhigalkin_p
0 / 0 / 0
Регистрация: 26.10.2017
Сообщений: 37
04.01.2018, 13:12  [ТС] #8
Вы правы, попробую FormulaR1C1

Добавлено через 3 часа 26 минут
Ну, вот, дописал.
Первый код:
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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim rngObj As Range
Dim i As Integer
Dim rngObjRange As Range
ActiveSheet.Unprotect
Set rngObjRange = Range("$M$16:$M$24")
For i = 1 To 30
    Set rngObjRange = Union(rngObjRange, Range("$M$16:$M$24").Offset(0, 13 * i))
Next i
If Intersect(Target, rngObjRange) Is Nothing Then
    ActiveSheet.Protect
    Exit Sub
Else
    Set rngObj = Intersect(Target, rngObjRange)
End If
    Cancel = True
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                rngObj.Offset(0, -4).Resize(1, 3).Interior.Color = 5287936
                rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value = rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value + rngObj.Offset(0, -1).Value
            Else
                Target = vbNullString
                rngObj.Offset(0, -4).Resize(1, 3).Interior.Pattern = xlNone
                rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value = rngObj.EntireColumn.Offset(0, 1).Cells(17, 1).Value - rngObj.Offset(0, -1).Value
            End If
    
Set rngObj = Nothing
Set rngObjRange = Nothing
ActiveSheet.Protect
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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
            
Dim rngChek As Range
Dim x As Integer
Dim rngChekRange As Range
ActiveSheet.Unprotect
    Set rngChekRange = Range("$K$3")
For x = 1 To 30
    Set rngChekRange = Union(rngChekRange, Range("$K$3").Offset(0, 13 * x))
Next x
If Intersect(Target, rngChekRange) Is Nothing Then
    'ActiveSheet.Protect
    Exit Sub
Else
    Set rngChek = Intersect(Target, rngChekRange)
End If
    Cancel = True
        With Target.Font
        .Name = "Marlett"
        .Size = 11
        End With
            If Target = vbNullString Then
                Target = "a"
                rngChek.Offset(9, -1).Range(Cells(, 1), Cells(, 6)).Value = "0"
                rngChek.Offset(14, 3).Cells(, 1).Value = "0"
                rngChek.Offset(18, 5).Cells(, 1).FormulaR1C1 = _
        "=IFERROR(IF((SUM(R[-16]C[-6]:R[-10]C[-1])/(COUNTA(R[-16]C[-6]:R[-10]C[-1])/6))=R[-4]C[3],""Все правильно"",""Неверно""),""Нет категорий!"")" 'P21
                rngChek.Offset(9, 9).Cells(, 1).FormulaR1C1 = "=R[5]C[-4]-SUM(RC[-10]:RC[-8])" 'T12
                rngChek.Offset(10, 9).Cells(, 1).FormulaR1C1 = "=R[4]C[-6]-SUM(R[-1]C[-7]:R[-1]C[-5])" 'T13
                rngChek.Offset(14, 8).Cells(, 1).FormulaR1C1 = "=SUM(R[-4]C[-9]:R[-4]C[-4])" 'S17
                    rngChek.Offset(, 2).Range(Cells(, 1), Cells(, 3)).EntireColumn.Hidden = False 
            
            Else
                Target = vbNullString
                rngChek.Offset(2, 2).Range(Cells(, 1), Cells(7, 3)).Value = "" 
                rngChek.Offset(9, -1).Range(Cells(, 1), Cells(, 6)).Value = "0" 
                rngChek.Offset(14, 3).Cells(, 1).Value = "0" 'Визирка Ноль
                rngChek.Offset(10, 9).Cells(, 1).ClearContents 'T13
                rngChek.Offset(14, 8).Cells(, 1).FormulaR1C1 = "=SUM(R[-4]C[-9]:R[-4]C[-7])" 'S17
                rngChek.Offset(13, 2).Range(Cells(, 1), Cells(9, 1)).Value = "" 
                
                rngChek.Offset(18, 5).Cells(, 1).FormulaR1C1 = _
        "=IFERROR(IF((SUM(R[-16]C[-6]:R[-10]C[-1])/(COUNTA(R[-16]C[-6]:R[-10]C[-1])/3))=R[-4]C[3],""Все правильно"",""Неверно""),""Нет категорий!"")"
                    rngChek.Offset(, 2).Range(Cells(, 1), Cells(, 3)).EntireColumn.Hidden = True 
                rngChek.Offset(13, -2).Range(Cells(, 1), Cells(9, 3)).Interior.Pattern = xlNone 'Нет заливки
            End If
Set rngChek = Nothing
Set rngObj = Nothing
Set rngObjRange = Nothing
'ActiveSheet.Protect
End Sub

Как их объединить в одном BeforeDoubleClick?
0
Burk
438 / 320 / 99
Регистрация: 11.07.2014
Сообщений: 1,079
04.01.2018, 13:26 #9
zhigalkin_p,
Цитата Сообщение от zhigalkin_p Посмотреть сообщение
Неужели никто не в силах помочь?
хорошо воспитанные программисты обычно отвечают на послания по их темам (см. вашу предыдущую тему). С новым годом!
0
zhigalkin_p
0 / 0 / 0
Регистрация: 26.10.2017
Сообщений: 37
04.01.2018, 14:25  [ТС] #10
Цитата Сообщение от Burk Посмотреть сообщение
хорошо воспитанные программисты обычно отвечают на послания по их темам
Прошу прощения, ответил. С новым Годом!
0
04.01.2018, 14:25
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
04.01.2018, 14:25
Привет! Вот еще темы с решениями:

Суммирование значений из нескольких книг
Добрый день! Существует около 10 книг Excel. Необходимо просуммировать...

Суммирование одинаковых значений таблицы
Имеется таблица 7 столбцов № Наименование Ед.измерения Норма Кол-во Цена...

Суммирование значений нескольких ячеек в одну
Здравствуйте дорогие эксперты. Хотел бы задать Вам один вопрос по поводу кода...

Некорректное суммирование повторяющихся значений. (scripting.dictionary)
Привет друзья! Много интересного и нужного почерпнул с Вашего форума, и видимо...


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

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

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