Подскажите пожалуйста как можно сделать макрос, который будет делать следующее: в имеющейся таблице есть n столбцов. в первом столбце есть поля, которые повторяются(например, "кот"), в другом столбце есть, стоимость 1-го столбца, нужно посчитать итого по полю "кот". Помогите пожалуйста!
Подскажите пожалуйста как можно сделать макрос, который будет делать следующее: в имеющейся таблице есть n столбцов. в первом столбце есть поля, которые повторяются(например, "кот"), в другом столбце есть, стоимость 1-го столбца, нужно посчитать итого по полю "кот". Помогите пожалуйста!lexa19921904
и при всем при этом надо, что бы макрос сам определил сколько таких повторяющихся полей типа "кот" и "слон", т.е. их нужно вводить не руками.
и при всем при этом надо, что бы макрос сам определил сколько таких повторяющихся полей типа "кот" и "слон", т.е. их нужно вводить не руками.lexa19921904
Sub ertert() Dim x, y(), i&, k&, n&, s$ x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 2) On Error Resume Next With New Collection For i = 2 To UBound(x) s = Trim$(x(i, 1)) If IsEmpty(.Item(s)) Then k = k + 1 y(k, 1) = "Total by field: " & s y(k, 2) = x(i, 3) .Add k, s Else n = .Item(s): y(n, 2) = y(n, 2) + x(i, 3) End If Next i End With With Range("A1").CurrentRegion With .Offset(.Rows.Count + 1, 1) .CurrentRegion.ClearContents .Resize(k, 2).Value = y() End With End With End Sub
[/vba]
пробуйте так: [vba]
Код
Sub ertert() Dim x, y(), i&, k&, n&, s$ x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 2) On Error Resume Next With New Collection For i = 2 To UBound(x) s = Trim$(x(i, 1)) If IsEmpty(.Item(s)) Then k = k + 1 y(k, 1) = "Total by field: " & s y(k, 2) = x(i, 3) .Add k, s Else n = .Item(s): y(n, 2) = y(n, 2) + x(i, 3) End If Next i End With With Range("A1").CurrentRegion With .Offset(.Rows.Count + 1, 1) .CurrentRegion.ClearContents .Resize(k, 2).Value = y() End With End With End Sub
Позволю себе вместо Николая - во избежание неожиданностей всегда лучше явно указывать, какое именно свойство мы хотим получить. У ячейки, диапазона множество свойств и если не указать нужное явно, Эксель по своему усмотрению подставит подходящее. А это не обязательно совпадет с желанием программиста.
Позволю себе вместо Николая - во избежание неожиданностей всегда лучше явно указывать, какое именно свойство мы хотим получить. У ячейки, диапазона множество свойств и если не указать нужное явно, Эксель по своему усмотрению подставит подходящее. А это не обязательно совпадет с желанием программиста. KuklP
Ну с НДС и мы чего-то стoим! kuklp60@gmail.com WM Z206653985942, R334086032478, U238399322728
Таблица, к которой я применяю этот макрос состоит из 486 строк и примерно из 25-30 столбцов. не знаю может это повлиять на вывод результата или нет...
Таблица, к которой я применяю этот макрос состоит из 486 строк и примерно из 25-30 столбцов. не знаю может это повлиять на вывод результата или нет...lexa19921904
Sub ertert() Dim x, y(), i&, k&, n&, s$ x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 2) On Error Resume Next With New Collection For i = 2 To UBound(x) s = Trim$(x(i, 1)) If Len(s) Then If IsEmpty(.Item(s)) Then k = k + 1 y(k, 1) = "Итого по " & s y(k, 2) = x(i, 4) .Add k, s Else n = .Item(s): y(n, 2) = y(n, 2) + x(i, 4) End If End If Next i End With With Range("A1").CurrentRegion With .Offset(.Rows.Count + 1, 1) .CurrentRegion.ClearContents .Resize(k, 2).Value = y() End With End With End Sub
...А это не обязательно совпадет с желанием программиста.
Да, точно И еще потому, что так советует ZVI.
вот без пустых подарков [vba]
Код
Sub ertert() Dim x, y(), i&, k&, n&, s$ x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 2) On Error Resume Next With New Collection For i = 2 To UBound(x) s = Trim$(x(i, 1)) If Len(s) Then If IsEmpty(.Item(s)) Then k = k + 1 y(k, 1) = "Итого по " & s y(k, 2) = x(i, 4) .Add k, s Else n = .Item(s): y(n, 2) = y(n, 2) + x(i, 4) End If End If Next i End With With Range("A1").CurrentRegion With .Offset(.Rows.Count + 1, 1) .CurrentRegion.ClearContents .Resize(k, 2).Value = y() End With End With End Sub
а можно сделать так, что бы при сборе цифр, если в ячейке написан текст, то появлялось сообщение об этой ошибке, и подсчет шел дальше, а в ячейке с итогом появилась надпись, что "не верные данные"?
а можно сделать так, что бы при сборе цифр, если в ячейке написан текст, то появлялось сообщение об этой ошибке, и подсчет шел дальше, а в ячейке с итогом появилась надпись, что "не верные данные"?lexa19921904
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
