Форум программистов, компьютерный форум, киберфорум
VBA
Форум программистов и сисадминов Киберфорум > Форум программистов > Basic > VBA
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Социальные группы Поиск Сообщения за день Заказать работу  
 
Рейтинг 4.63/8: Рейтинг темы: голосов - 8, средняя оценка - 4.63
0 / 0 / 0
Регистрация: 23.08.2015
Сообщений: 26
1

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

07.10.2015, 11:07. Показов 1579. Ответов 3
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
Здравствуйте.
Есть задача такая:
Необходимо из листа АСУТПиМ перенести на лист МатерХРиГСМ данные
причем если в листе АСУТПиМ стоит вид ремонта "капитальный" то к в лист МатерХРиГСМ под строкой <Наименование ГТМЦ> (например "Запорная и регулирующая арматура и фасонные части" или "Электродвигатели, электроагрегаты и энергосберегающее оборудование и зап. части") под ячейкой "капитальный" добавить строку с наименованием товара, ценой, количеством и суммой, который был указан на листе АСУТПиМ.
Эту часть я сделал
Вопрос в том что что нужно напротив ячейки капитальный (или другой какой нибудь вид ремонта) добавить сумму всех сумм и сумму всех количеств товара.
pr.7z
0
Лучшие ответы (1)
Сообщение: #8184524
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 07.10.2015, 11:07
Ответы с готовыми решениями:

Подсчет количества непустых ячеек диапазона
Есть диапазон rang1=range(cells(a,b), cells(c,d))' где a,b,c,d заранее определенные переменные....

Ввод заранее неизвестного количества строк
Знающие люди помогите! Необходимо ввести с консоли определнное количество строк, заранее не...

Программное создание неизвестного заранее количества массивов
Доброго времени суток. Помогите пожалуйста решить задачу. Необходимо программно создавать...

Заполнение заранее неизвестного количества байт (tasm)
Читал на хабре статью Пишем свою ОС. Там был приведен код загрузчика на yasm. И так как код...

3
5605 / 1591 / 412
Регистрация: 23.12.2010
Сообщений: 2,382
Записей в блоге: 1
08.10.2015, 13:32 2
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
1
0 / 0 / 0
Регистрация: 23.08.2015
Сообщений: 26
10.10.2015, 18:05  [ТС] 3
Спасибо
но у меня на 33 строке, а именно
.Value = .Value + Лист1.Cells(x, S1a(i)).Value:
ошибка возникает runtime error 1004 application-defined or object-defined error

Добавлено через 4 часа 45 минут
KoGG, спасибо, разобрался, но у меня есть теперь такой косяк
он не правильно немного сортирует. т.е. если автошина например стоит в одном месте аварийная, а в другом прочая, то он добавляет в прочую все((
0
5605 / 1591 / 412
Регистрация: 23.12.2010
Сообщений: 2,382
Записей в блоге: 1
12.10.2015, 16:04 4
Лучший ответ Сообщение было отмечено yogi как решение

Решение

То, что было изначально сделано - неверно, косметическая оптимизация этому не помогла.
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
1
12.10.2015, 16:04
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 12.10.2015, 16:04
Помогаю со студенческими работами здесь

Запись с консоли в массив неизвестного заранее количества элементов
Друзья, всем привет! Парюсь над задачкой: Ввести значения с консоли и определить максимальное...

Ввод заранее неизвестного количества чисел массива с клавиатуры
Как написать код, чтобы пользователь вводил числа в массив количество элементов которого не известно

Считывание заранее неизвестного количества вещественных чисел из файла
Работаю в среде VisualC++ 6.0. Всё что можно сделать алгоритмом чистого си делаю так. Привычка,...

Подсчет количества ячеек
помогите с запросом (новичок поэтому неправильно сформулировать): есть база xxx.dbf в ней столбец...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru