Подсчет суммы заранее неизвестного количества ячеек

@yogi · Регистрация: 23.08.2015

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

Здравствуйте.
Есть задача такая:
Необходимо из листа АСУТПиМ перенести на лист МатерХРиГСМ данные
причем если в листе АСУТПиМ стоит вид ремонта "капитальный" то к в лист МатерХРиГСМ под строкой <Наименование ГТМЦ> (например "Запорная и регулирующая арматура и фасонные части" или "Электродвигатели, электроагрегаты и энергосберегающее оборудование и зап. части") под ячейкой "капитальный" добавить строку с наименованием товара, ценой, количеством и суммой, который был указан на листе АСУТПиМ.
Эту часть я сделал
Вопрос в том что что нужно напротив ячейки капитальный (или другой какой нибудь вид ремонта) добавить сумму всех сумм и сумму всех количеств товара.
pr.7z

@KoGG · 08.10.2015, 13:32

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
Sub mater()
    Dim i&, j&, A&, B&, x&, Z&, StartSum, StartSumOld&, EndSum&, S1, S2, S1a, S2a, CenySt, sVid
    S1 = Array(9, 11, 10, 12, 13, 14, 15, 16, 17, 18, 19, 20, 24, 25, 26, 27, 28, 29, 30, 31, 32, 36, 37, 38, 39, 40, 41, 42, 43, 44, 48, 49, 50, 51, 52, 53, 54, 55, 56)
    S2 = Array(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)
    CenySt = Array(7, 10, 13, 16, 19, 22, 25, 28, 31, 34, 37, 40)
    S1a = Array(12, 14, 15, 17, 18, 20, 24, 26, 27, 29, 30, 32, 36, 38, 39, 41, 42, 44, 48, 50, 51, 53, 54, 56)
    S2a = Array(6, 8, 9, 11, 12, 14, 15, 17, 18, 20, 21, 23, 24, 26, 27, 29, 30, 32, 33, 35, 36, 38, 39, 41)
    sVid = Array(6, 7, 7, 7, 7)
    Vid1 = Split("Аварийная|Прочие|Текущий|Капитальный|Сторонние", "|")
    Vid2 = Split("Аварийный ремонт|Прочие работы|Текущий ремонт|Капитальный ремонт|Сторонние заказы", "|")
    mat3 = 1
    B = Лист1.Cells(Rows.Count, 3).End(xlUp).Row
    Application.Calculation = xlCalculationManual
    For x = 4 To B
        If Лист1.Cells(x, 8).Text <> "ГСМ" Or Лист1.Cells(x, 8).Text <> "Химреагенты" Then
            A = Лист2.Cells(Rows.Count, 3).End(xlUp).Row
            FindRow = False
            For Z = 5 To A
                If Лист2.Cells(Z, 3).Value = Лист1.Cells(x, 8).Value Then ' если в столбце совпадает группа ТМЦ
                    mat = 1
                    mat3 = 1
                    FindRow = True
                    Exit For
                End If
            Next Z
            If FindRow Then ' Добавлено: доп. проверка циклом по номенклатуре
                FindRow = False
                For j = Z To A ' Цикл добавлен
                     If Trim$(Лист2.Cells(j, 3)) = Trim$(Лист1.Cells(x, 9)) Then ' Исправлено, совпала Номенклатура
                        ' If Лист5.Cells(Z, 3).Text = Лист1.Cells(x, 9).Text Then ' Исходная
                         FindRow = True
                         For i = 0 To UBound(S1a)
                            With Лист2.Cells(j, S2a(i)): .Value = .Value + Лист1.Cells(x, S1a(i)).Value: End With
                         Next i
                         For i = 0 To UBound(CenySt)
                            Лист2.Cells(j, CenySt(i)).FormulaR1C1 = "=IFERROR(RC[1]/RC[-1],0)"
                         Next i
                         Exit For
                     End If
                Next j
            End If
            If Not FindRow Then
                For j = 0 To UBound(Vid1)
                    uAvar = False
                    If Лист1.Cells(x, sVid(j)) = Vid1(j) Then
                        mat = 0
                        mat1 = Z
                        For mat2 = mat1 To A
                            If Лист2.Cells(mat2, 3) = Vid2(j) Then
                                Лист2.Cells(mat2 + mat3, 3).EntireRow.Insert
                                For i = 0 To UBound(S1)
                                    Лист2.Cells(mat2 + mat3, S2(i)).Value = Лист1.Cells(x, S1(i)).Value
                                Next i
                                mat3 = mat3 + 1
                                If j = 0 Then uAvar = True
                                Exit For
                            End If
                        Next
                    End If
                    If uAvar Then Exit For
                 Next j
             End If
             ' notavary:
        End If
    Next x
    StartSum = 7
    For i = 5 To A
        Select Case Лист2.Cells(i, 3)
            Case "Аварийный ремонт", "Прочие работы", "Текущий ремонт", "Капитальный ремонт", "Сторонние заказы"
                EndSum = i - 1
                StartSumOld = StartSum
                StartSum = i + 1
            Case Else
                If Trim$(Лист2.Cells(i, 1)) <> "" Then
                    EndSum = i - 1
                    StartSum = -1
                End If
        End Select
        If EndSum >= StartSumOld And StartSumOld > 0 Then
            For j = 0 To UBound(S2a)
               Лист2.Cells(StartSumOld - 1, S2a(j)).FormulaR1C1 = "=SUM(R" & StartSumOld & "C:R" & EndSum & "C)"
            Next j
            EndSum = -2
        End If
    Next i
    Application.Calculation = xlCalculationAutomatic
End Sub

@yogi · 10.10.2015, 18:05 **[ТС]**

Спасибо
но у меня на 33 строке, а именно
.Value = .Value + Лист1.Cells(x, S1a(i)).Value:
ошибка возникает runtime error 1004 application-defined or object-defined error

Добавлено через 4 часа 45 минут
KoGG, спасибо, разобрался, но у меня есть теперь такой косяк
он не правильно немного сортирует. т.е. если автошина например стоит в одном месте аварийная, а в другом прочая, то он добавляет в прочую все((

@KoGG · 12.10.2015, 16:04

То, что было изначально сделано - неверно, косметическая оптимизация этому не помогла.

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
Sub mater()
    Dim i&, j&, k&, j1&, j2&, A&, B&, x&, Z&, StartSum, StartSumOld&, EndSum&, S1, S2, S1a, S2a, CenySt, sVid, FindRow As Boolean
    S1 = Array(9, 11, 10, 12, 13, 14, 15, 16, 17, 18, 19, 20, 24, 25, 26, 27, 28, 29, 30, 31, 32, 36, 37, 38, 39, 40, 41, 42, 43, 44, 48, 49, 50, 51, 52, 53, 54, 55, 56)
    S2 = Array(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)
    CenySt = Array(7, 10, 13, 16, 19, 22, 25, 28, 31, 34, 37, 40)
    S1a = Array(12, 14, 15, 17, 18, 20, 24, 26, 27, 29, 30, 32, 36, 38, 39, 41, 42, 44, 48, 50, 51, 53, 54, 56)
    S2a = Array(6, 8, 9, 11, 12, 14, 15, 17, 18, 20, 21, 23, 24, 26, 27, 29, 30, 32, 33, 35, 36, 38, 39, 41)
    sVid = Array(7, 7, 6, 7, 7)
    Vid1 = Split("Капитальный|Текущий|Аварийная|Прочие|Сторонние", "|")
    Vid2 = Split("Капитальный ремонт|Текущий ремонт|Аварийный ремонт|Прочие работы|Сторонние заказы|##", "|")
    mat3 = 1
    B = Лист1.Cells(Rows.Count, 3).End(xlUp).Row
    Application.Calculation = xlCalculationManual
    For x = 4 To B
        If Лист1.Cells(x, 8).Text <> "ГСМ" Or Лист1.Cells(x, 8).Text <> "Химреагенты" Then
            A = Лист2.Cells(Rows.Count, 3).End(xlUp).Row
            FindRow = False
            For Z = 5 To A
                If Лист2.Cells(Z, 3).Value = Лист1.Cells(x, 8).Value Then ' если в столбце совпадает группа ТМЦ
                    mat = 1
                    mat3 = 1
                    FindRow = True
                    Exit For
                End If
            Next Z
            If FindRow Then ' Добавлено: доп. проверка циклом по номенклатуре
               FindRow = False
               For k = 0 To UBound(Vid1)
                   If Trim$(Лист1.Cells(x, sVid(k))) = Vid1(k) Then
                        For j = Z + 1 To A
                            Select Case Trim$(Лист2.Cells(j, 3))
                                Case Vid2(k) ' Начало данного вида ремонта
                                    j1 = j
                                Case Vid2(k + 1) ' Начало следующего вида ремонта
                                    j2 = j
                                    Exit For
                            End Select
                            If Trim$(Лист2.Cells(j, 1)) <> "" Then j2 = j: Exit For  ' Начало следующей группы ТМЦ
                        Next j
                        For j = j1 To j2
                            If Trim$(Лист2.Cells(j, 3)) = Trim$(Лист1.Cells(x, 9)) Then ' совпала Номенклатура
                                FindRow = True
                                For i = 0 To UBound(S1a)
                                   With Лист2.Cells(j, S2a(i)): .Value = .Value + Лист1.Cells(x, S1a(i)).Value: End With
                                Next i
                                For i = 0 To UBound(CenySt)
                                   Лист2.Cells(j, CenySt(i)).FormulaR1C1 = "=IFERROR(RC[1]/RC[-1],0)"
                                Next i
                                Exit For
                            End If
                        Next j
                        Exit For
                    End If
                Next k
            End If
            If Not FindRow Then
                For k = 0 To UBound(Vid1)
                    If Trim$(Лист1.Cells(x, sVid(k))) = Vid1(k) Then
                        mat1 = Z + 1
                        For mat2 = mat1 To A
                            Select Case Trim$(Лист2.Cells(mat2, 3))
                                Case Vid2(k)
                                    Лист2.Cells(mat2 + 1, 3).EntireRow.Insert
                                    For i = 0 To UBound(S1)
                                        Лист2.Cells(mat2 + 1, S2(i)).Value = Лист1.Cells(x, S1(i)).Value
                                    Next i
                                    Exit For
                                Case Vid2(k + 1)
                                    Exit For
                            End Select
                            If Trim$(Лист2.Cells(mat2 + 1, 1)) <> "" Then Exit For ' Начало следующей группы ТМЦ
                        Next
                        Exit For
                    End If
                 Next k
             End If
        End If
    Next x
    StartSum = 7
    For i = 5 To A
        Select Case Лист2.Cells(i, 3)
            Case "Аварийный ремонт", "Прочие работы", "Текущий ремонт", "Капитальный ремонт", "Сторонние заказы"
                EndSum = i - 1
                StartSumOld = StartSum
                StartSum = i + 1
            Case Else
                If Trim$(Лист2.Cells(i, 1)) <> "" Then
                    EndSum = i - 1
                    StartSum = -1
                End If
        End Select
        If EndSum >= StartSumOld And StartSumOld > 0 Then
            For j = 0 To UBound(S2a)
               Лист2.Cells(StartSumOld - 1, S2a(j)).FormulaR1C1 = "=SUM(R" & StartSumOld & "C:R" & EndSum & "C)"
            Next j
            EndSum = -2
        End If
    Next i
    Application.Calculation = xlCalculationAutomatic
End Sub

Новые блоги и статьи Все статьи Все блоги /
Access VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .
Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .	Фото: Daniel Greenwood kumehtar 13.11.2025

@yogi 0 / 0 / 0 Регистрация: 23.08.2015 Сообщений: 26

	Подсчет суммы заранее неизвестного количества ячеек 07.10.2015, 11:07. Показов 1806. Ответов 3 Метки нет (Все метки) Здравствуйте. Есть задача такая: Необходимо из листа АСУТПиМ перенести на лист МатерХРиГСМ данные причем если в листе АСУТПиМ стоит вид ремонта "капитальный" то к в лист МатерХРиГСМ под строкой <Наименование ГТМЦ> (например "Запорная и регулирующая арматура и фасонные части" или "Электродвигатели, электроагрегаты и энергосберегающее оборудование и зап. части") под ячейкой "капитальный" добавить строку с наименованием товара, ценой, количеством и суммой, который был указан на листе АСУТПиМ. Эту часть я сделал Вопрос в том что что нужно напротив ячейки капитальный (или другой какой нибудь вид ремонта) добавить сумму всех сумм и сумму всех количеств товара. pr.7z 0

@yogi 0 / 0 / 0 Регистрация: 23.08.2015 Сообщений: 26
	10.10.2015, 18:05 [ТС]
	Спасибо но у меня на 33 строке, а именно .Value = .Value + Лист1.Cells(x, S1a(i)).Value: ошибка возникает runtime error 1004 application-defined or object-defined error Добавлено через 4 часа 45 минут KoGG, спасибо, разобрался, но у меня есть теперь такой косяк он не правильно немного сортирует. т.е. если автошина например стоит в одном месте аварийная, а в другом прочая, то он добавляет в прочую все(( 0

Подсчет суммы заранее неизвестного количества ячеек

Решение