Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/сумма строк если в столбце подряд идут одинаковые названия - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Работа и общение » Работа / Фриланс » сумма строк если в столбце подряд идут одинаковые названия
сумма строк если в столбце подряд идут одинаковые названия
Sasha318 Дата: Четверг, 22.02.2018, 15:25 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 37
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Всем привет помогите советом,
уже есть макрос но его бы до ума довести. Суть заключается в том что есть столбец со статичными данными а рядом количество той или иной позиции, но с индексами разными, необходимо их переименовать с другим индексом.
Есть вот такой макрос
[vba]
Код
Sub счёт()
'объявим текстовы переменные, которым будем присваивать значения
Dim temp1 As String, temp2 As String
'отключим автообновление экрана
Application.ScreenUpdating = False
'объявим нашу коллекцию и будем добавлять в нее тестовые значения
'из 3 столбца без последних трех символов
With New Collection
'запустим цикл для последовательной обработки
'каждого значения из третьего столбца
For i = 1 To 9 ' цикл перебирает все 8 значений из примера
'(в окончательном варианте нужно правильно откорректировать
'условие цикла, чтобы перебрать все необходимые значения)
'для этого например можно воспользоваться поиском последней
'заполненной строки в столбце, к примеру:
lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
'выражение даст номер строки последнего элемента в 3 столбце
'подсчитать количество значений в столбце не сложно,
'зная вехнее и нижнее значение, подсчитав их разницу
temp1 = Cells(i + 3, 3)
'переменной temp1 последовательно присваиваются значения из 3 столбца
' начиная с 4 строки, т.к. i + 3 при i=1 дает (1+3)=4
' все это продолжается до 11 строки, т.к. при i=8 (8+3)=11
temp2 = Mid(temp1, 1, Len(temp1) - 3)
'переменной temp2 последовательно присваиваются значения из 3 столбца,
'но без 3 последних символов!!! отбрасываем "LH" либо "RH" c пробелами
On Error Resume Next 'отключение возможных ошибок
.Add temp2, Key:=CStr(temp2) 'добавляем в коллекцию значение переменной temp2
If Err = 0 Then 'проверка на возможность добавления в коллецию
'т.е. если в коллеции нет такого элемента и не вызвана ошибка
'то выполняются все действия, организованные ниже
li = li + 1 'счетчик сробатывания условия, описанного выше
'т.к. при добавлении в коллекцию неповторяющихся одиночных значений
'не возникает никаких ошибок, то просто перезаписываем значения
'текущей строки в другие столбцы без изменений
'в данном случае в 34,43,44,46 и 46 стоблцы из 3,12,13,14 и 15 столбцов
Cells(li + 3, 34) = temp1
Cells(li + 3, 43) = Cells(i + 3, 12)
Cells(li + 3, 44) = Cells(i + 3, 13)
Cells(li + 3, 45) = Cells(i + 3, 14)
Cells(li + 3, 46) = Cells(i + 3, 15)
Else ' "иначе"
'то есть здесь подразумевается, что при добалении в коллекцию
'вознила ошибка, т.е. пыталось добавится новое значение равное
'предыдущему (значения без 3 последних символов)
'в таком случае описана другая последовательность действий
'при наступлении такого события
Cells(li + 3, 34) = temp2 & " RH\LH"
'здесь мы к значению с отброшенными 3 символами добавляем
'новые символы, а именно " RH\LH"
'и далее все перезаписываем по аналогии выше с той лишь разницей
'что суммируем значение выше
Cells(li + 3, 43) = Cells(i + 3, 12) + Cells(i + 2, 12)
Cells(li + 3, 44) = Cells(i + 3, 13) + Cells(i + 2, 13)
Cells(li + 3, 45) = Cells(i + 3, 14) + Cells(i + 2, 14)
Cells(li + 3, 46) = Cells(i + 3, 15) + Cells(i + 2, 15)
Err.Clear
End If
Next i 'закрываем цикл
'закрываем формирование коллекции
End With
'включим автообновление экрана
Application.ScreenUpdating = True
End Sub

[/vba]

Задание вложил с примером
К сообщению приложен файл: 2458590.xlsx (14.2 Kb)


Сообщение отредактировал Sasha318 - Четверг, 22.02.2018, 15:28
 
Ответить
СообщениеВсем привет помогите советом,
уже есть макрос но его бы до ума довести. Суть заключается в том что есть столбец со статичными данными а рядом количество той или иной позиции, но с индексами разными, необходимо их переименовать с другим индексом.
Есть вот такой макрос
[vba]
Код
Sub счёт()
'объявим текстовы переменные, которым будем присваивать значения
Dim temp1 As String, temp2 As String
'отключим автообновление экрана
Application.ScreenUpdating = False
'объявим нашу коллекцию и будем добавлять в нее тестовые значения
'из 3 столбца без последних трех символов
With New Collection
'запустим цикл для последовательной обработки
'каждого значения из третьего столбца
For i = 1 To 9 ' цикл перебирает все 8 значений из примера
'(в окончательном варианте нужно правильно откорректировать
'условие цикла, чтобы перебрать все необходимые значения)
'для этого например можно воспользоваться поиском последней
'заполненной строки в столбце, к примеру:
lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
'выражение даст номер строки последнего элемента в 3 столбце
'подсчитать количество значений в столбце не сложно,
'зная вехнее и нижнее значение, подсчитав их разницу
temp1 = Cells(i + 3, 3)
'переменной temp1 последовательно присваиваются значения из 3 столбца
' начиная с 4 строки, т.к. i + 3 при i=1 дает (1+3)=4
' все это продолжается до 11 строки, т.к. при i=8 (8+3)=11
temp2 = Mid(temp1, 1, Len(temp1) - 3)
'переменной temp2 последовательно присваиваются значения из 3 столбца,
'но без 3 последних символов!!! отбрасываем "LH" либо "RH" c пробелами
On Error Resume Next 'отключение возможных ошибок
.Add temp2, Key:=CStr(temp2) 'добавляем в коллекцию значение переменной temp2
If Err = 0 Then 'проверка на возможность добавления в коллецию
'т.е. если в коллеции нет такого элемента и не вызвана ошибка
'то выполняются все действия, организованные ниже
li = li + 1 'счетчик сробатывания условия, описанного выше
'т.к. при добавлении в коллекцию неповторяющихся одиночных значений
'не возникает никаких ошибок, то просто перезаписываем значения
'текущей строки в другие столбцы без изменений
'в данном случае в 34,43,44,46 и 46 стоблцы из 3,12,13,14 и 15 столбцов
Cells(li + 3, 34) = temp1
Cells(li + 3, 43) = Cells(i + 3, 12)
Cells(li + 3, 44) = Cells(i + 3, 13)
Cells(li + 3, 45) = Cells(i + 3, 14)
Cells(li + 3, 46) = Cells(i + 3, 15)
Else ' "иначе"
'то есть здесь подразумевается, что при добалении в коллекцию
'вознила ошибка, т.е. пыталось добавится новое значение равное
'предыдущему (значения без 3 последних символов)
'в таком случае описана другая последовательность действий
'при наступлении такого события
Cells(li + 3, 34) = temp2 & " RH\LH"
'здесь мы к значению с отброшенными 3 символами добавляем
'новые символы, а именно " RH\LH"
'и далее все перезаписываем по аналогии выше с той лишь разницей
'что суммируем значение выше
Cells(li + 3, 43) = Cells(i + 3, 12) + Cells(i + 2, 12)
Cells(li + 3, 44) = Cells(i + 3, 13) + Cells(i + 2, 13)
Cells(li + 3, 45) = Cells(i + 3, 14) + Cells(i + 2, 14)
Cells(li + 3, 46) = Cells(i + 3, 15) + Cells(i + 2, 15)
Err.Clear
End If
Next i 'закрываем цикл
'закрываем формирование коллекции
End With
'включим автообновление экрана
Application.ScreenUpdating = True
End Sub

[/vba]

Задание вложил с примером

Автор - Sasha318
Дата добавления - 22.02.2018 в 15:25
doober Дата: Четверг, 22.02.2018, 15:33 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Написал в личку


 
Ответить
СообщениеНаписал в личку

Автор - doober
Дата добавления - 22.02.2018 в 15:33
doober Дата: Четверг, 22.02.2018, 21:20 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Сдал,оплату получил


 
Ответить
СообщениеСдал,оплату получил

Автор - doober
Дата добавления - 22.02.2018 в 21:20
ansat7575 Дата: Пятница, 09.03.2018, 21:01 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Sasha318,
К сообщению приложен файл: aa.xlsx (12.0 Kb)
 
Ответить
СообщениеSasha318,

Автор - ansat7575
Дата добавления - 09.03.2018 в 21:01
Мир MS Excel » Работа и общение » Работа / Фриланс » сумма строк если в столбце подряд идут одинаковые названия
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!