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

@zhigalkin_p · Регистрация: 26.10.2017

Студворк — интернет-сервис помощи студентам

Доброго времени суток, уважаемые форумчане!
Прошу опять вашей помощи.
Имеется код:

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 ячеек.
Файл прикладываю, (фрагмент)

@zhigalkin_p · 04.01.2018, 07:45 **[ТС]**

Неужели никто не в силах помочь?

@Dinoxromniy · 04.01.2018, 08:29

Сообщение от 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 & ")"

@zhigalkin_p · 04.01.2018, 08:59 **[ТС]**

Пробовал вот так:

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 минуту
Ан, нет, выдает сумма ячеек ноль

@Dinoxromniy · 04.01.2018, 09:00

Сообщение от zhigalkin_p

что-то не получается....

zhigalkin_p, взял ваш файл, вставил в строку 31 вашего первого кода формулу из поста 3.
Результатом - при проставленной галочке в ячейке P21 устанавливается формула =СУММ($J$5; $O$11).
Какой результат нужен вам?

@zhigalkin_p · 04.01.2018, 09:10 **[ТС]**

Мне надо, чтобы в ячейке 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 (ну, по крайней мере, я так думаю надо сделать).

@Dinoxromniy · 04.01.2018, 09:40

Сообщение от 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 эта формула ровно постоянна и звучит как

Code
1
=ЕСЛИОШИБКА(ЕСЛИ((СУММ(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? В чем преимущество?

@zhigalkin_p · 04.01.2018, 13:12 **[ТС]**

Вы правы, попробую 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?

@Burk · 04.01.2018, 13:26

zhigalkin_p,

Сообщение от zhigalkin_p

Неужели никто не в силах помочь?

хорошо воспитанные программисты обычно отвечают на послания по их темам (см. вашу предыдущую тему). С новым годом!

@zhigalkin_p · 04.01.2018, 14:25 **[ТС]**

Сообщение от Burk

хорошо воспитанные программисты обычно отвечают на послания по их темам

Прошу прощения, ответил. С новым Годом!

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .
SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 28.01.2026 Содержание блога SDL3 имеет собственные средства для загрузки и отображения PNG-файлов с альфа-каналом и базовой работы с ними. В этой инструкции используется функция SDL_LoadPNG(), которая. . .

@zhigalkin_p 1 / 1 / 0 Регистрация: 26.10.2017 Сообщений: 108
	04.01.2018, 07:45 [ТС]
	Неужели никто не в силах помочь? 0