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

Вход

Регистрация

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

 

= Мир MS Excel/переименовывание ячейки с данными и суммирование строк - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » переименовывание ячейки с данными и суммирование строк (Макросы/Sub)
переименовывание ячейки с данными и суммирование строк
Sasha318 Дата: Пятница, 09.02.2018, 20:28 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
всем привет. может что-то не возможное в голову пришло попросить у эксель.
Но всё же может есть выход какой.
есть статичные данные всё время в одном и том же столбще но с приставкой LH RH, допустим крыло LH, ниже крыло RH и рядом количество правых и количество левых, можно их объеденить в одной ячейке с названием крыло RH\LH и суммировать их колличество? может хоть не одной кнопкой, но как то упростить это выполнение, был бы благодарен за идею
К сообщению приложен файл: 3751224.xlsx(12.7 Kb)
 
Ответить
Сообщениевсем привет. может что-то не возможное в голову пришло попросить у эксель.
Но всё же может есть выход какой.
есть статичные данные всё время в одном и том же столбще но с приставкой LH RH, допустим крыло LH, ниже крыло RH и рядом количество правых и количество левых, можно их объеденить в одной ячейке с названием крыло RH\LH и суммировать их колличество? может хоть не одной кнопкой, но как то упростить это выполнение, был бы благодарен за идею

Автор - Sasha318
Дата добавления - 09.02.2018 в 20:28
fan-vba Дата: Пятница, 09.02.2018, 23:51 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 10 ±
Замечаний: 0% ±

Excel 2007
я бы попробовал примерно по такой идее решить задачу
[vba]
Код
Sub otvet()
Dim temp1 As String, temp2 As String
Dim mass()
Application.ScreenUpdating = False

With New Collection
For i = 1 To 8
temp1 = Cells(i + 3, 3)
temp2 = Mid(temp1, 1, Len(temp1) - 3)
On Error Resume Next
.Add temp2, Key:=CStr(temp2)
If Err = 0 Then
li = li + 1
ReDim Preserve mass(1 To li)
mass(li) = temp1
Cells(li + 3, 34) = mass(li)
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
mass(li) = temp2 & " RH\LH"
Cells(li + 3, 34) = mass(li)
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]

неуклюже все)))... находу накидал, хотел все через массив сделать, а потом выплюнуть на лист, но вариант решения рабочий


Сообщение отредактировал fan-vba - Пятница, 09.02.2018, 23:58
 
Ответить
Сообщениея бы попробовал примерно по такой идее решить задачу
[vba]
Код
Sub otvet()
Dim temp1 As String, temp2 As String
Dim mass()
Application.ScreenUpdating = False

With New Collection
For i = 1 To 8
temp1 = Cells(i + 3, 3)
temp2 = Mid(temp1, 1, Len(temp1) - 3)
On Error Resume Next
.Add temp2, Key:=CStr(temp2)
If Err = 0 Then
li = li + 1
ReDim Preserve mass(1 To li)
mass(li) = temp1
Cells(li + 3, 34) = mass(li)
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
mass(li) = temp2 & " RH\LH"
Cells(li + 3, 34) = mass(li)
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]

неуклюже все)))... находу накидал, хотел все через массив сделать, а потом выплюнуть на лист, но вариант решения рабочий

Автор - fan-vba
Дата добавления - 09.02.2018 в 23:51
Sasha318 Дата: Суббота, 10.02.2018, 00:12 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
fan-vba, благодарю)) попробую из этого что то намутить)) если что обращусь)
 
Ответить
Сообщениеfan-vba, благодарю)) попробую из этого что то намутить)) если что обращусь)

Автор - Sasha318
Дата добавления - 10.02.2018 в 00:12
Sasha318 Дата: Суббота, 10.02.2018, 00:17 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
fan-vba, извини, а мог бы ты сделать с комментариями?) у меня просто там много данных, я только часть дал
 
Ответить
Сообщениеfan-vba, извини, а мог бы ты сделать с комментариями?) у меня просто там много данных, я только часть дал

Автор - Sasha318
Дата добавления - 10.02.2018 в 00:17
fan-vba Дата: Суббота, 10.02.2018, 08:16 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 24
Репутация: 10 ±
Замечаний: 0% ±

Excel 2007
Доброго времени суток Sasha318, попробую пояснить вам суть метода, реализацию исходного кода попробуйте осуществить сами, т.к. Вы не предоставили оригинального файла.
Давайте разбираться по порядку, у вас в 3 столбце с 4 по 11 строку находятся текстовые данные, которые мы хотим обработать каким-то образом. Для этого нам необходимо последовательно перебрать все эти значения, для этого существует масса способов, в данном случае воспользуемся циклом For Next. Затем у каждого значения будем отбрасывать 3 последних символа (чтобы отбросить « RH» либо « LH») и полученные текстовые значения добавлять в коллекцию. При добавлении в коллекцию текстовых значений с отброшенными окончаниями начиная с «P32S DOOR FRT OTR» при повторном добавлении срабатывает ошибка, т.к. значение «P32S DOOR FRT OTR» уже добавлено на предыдущем шаге, а в коллекции не может быть 2 одинаковых значения – возникает ошибка и при ее возникновении назначена соответствующая обработка текста, а именно добавление в конце « RH\LH» и суммирование определенных значений. Попробую раскомментировать код:

[vba]
Код
Sub otvet()
'объявим текстовы переменные, которым будем присваивать значения
Dim temp1 As String, temp2 As String
'отключим автообновление экрана
Application.ScreenUpdating = False
'объявим нашу коллекцию и будем добавлять в нее тестовые значения
'из 3 столбца без последних трех символов
With New Collection
'запустим цикл для последовательной обработки
'каждого значения из третьего столбца
For i = 1 To 8 ' цикл перебирает все 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]

Хочу обратить внимание, что данный метод подразумевает, что значения с RH и LH идут строго друг после друга и не разбросанны по стобцу на разных позициях, если это не так, то огранизация кода должна быть несколько иная, т.к.
допустим крыло LH, ниже крыло RH и рядом количество правых и количество левых


Сообщение отредактировал fan-vba - Суббота, 10.02.2018, 08:26
 
Ответить
СообщениеДоброго времени суток Sasha318, попробую пояснить вам суть метода, реализацию исходного кода попробуйте осуществить сами, т.к. Вы не предоставили оригинального файла.
Давайте разбираться по порядку, у вас в 3 столбце с 4 по 11 строку находятся текстовые данные, которые мы хотим обработать каким-то образом. Для этого нам необходимо последовательно перебрать все эти значения, для этого существует масса способов, в данном случае воспользуемся циклом For Next. Затем у каждого значения будем отбрасывать 3 последних символа (чтобы отбросить « RH» либо « LH») и полученные текстовые значения добавлять в коллекцию. При добавлении в коллекцию текстовых значений с отброшенными окончаниями начиная с «P32S DOOR FRT OTR» при повторном добавлении срабатывает ошибка, т.к. значение «P32S DOOR FRT OTR» уже добавлено на предыдущем шаге, а в коллекции не может быть 2 одинаковых значения – возникает ошибка и при ее возникновении назначена соответствующая обработка текста, а именно добавление в конце « RH\LH» и суммирование определенных значений. Попробую раскомментировать код:

[vba]
Код
Sub otvet()
'объявим текстовы переменные, которым будем присваивать значения
Dim temp1 As String, temp2 As String
'отключим автообновление экрана
Application.ScreenUpdating = False
'объявим нашу коллекцию и будем добавлять в нее тестовые значения
'из 3 столбца без последних трех символов
With New Collection
'запустим цикл для последовательной обработки
'каждого значения из третьего столбца
For i = 1 To 8 ' цикл перебирает все 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]

Хочу обратить внимание, что данный метод подразумевает, что значения с RH и LH идут строго друг после друга и не разбросанны по стобцу на разных позициях, если это не так, то огранизация кода должна быть несколько иная, т.к.
допустим крыло LH, ниже крыло RH и рядом количество правых и количество левых

Автор - fan-vba
Дата добавления - 10.02.2018 в 08:16
InExSu Дата: Воскресенье, 11.02.2018, 22:43 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 385
Репутация: 50 ±
Замечаний: 60% ±

Excel 2010
Привет!
Два дополнительных столбца и сводная.
К сообщению приложен файл: InExSu_Sasha318.xlsx(17.5 Kb)


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеПривет!
Два дополнительных столбца и сводная.

Автор - InExSu
Дата добавления - 11.02.2018 в 22:43
Sasha318 Дата: Пятница, 16.02.2018, 12:04 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
привет, спасибо за подробный ответ, с этим я разобрался, пытался применить еще один параметр и не выходит, что если есть еще roof (25 hole) и roof (17 hole) и сделать так чтобы перенеслось без названий в ковычках, просто roof
 
Ответить
Сообщениепривет, спасибо за подробный ответ, с этим я разобрался, пытался применить еще один параметр и не выходит, что если есть еще roof (25 hole) и roof (17 hole) и сделать так чтобы перенеслось без названий в ковычках, просто roof

Автор - Sasha318
Дата добавления - 16.02.2018 в 12:04
Sasha318 Дата: Пятница, 16.02.2018, 12:05 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
InExSu, спасибо за старания но это не то что нужно))
 
Ответить
СообщениеInExSu, спасибо за старания но это не то что нужно))

Автор - Sasha318
Дата добавления - 16.02.2018 в 12:05
Sasha318 Дата: Пятница, 16.02.2018, 12:19 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 23
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
fan-vba, во вложении вложил ниже табличку со всеми параметрами что хочу обьединить. помогите пожалуйста
К сообщению приложен файл: 37512242.xlsx(12.9 Kb)


Сообщение отредактировал Sasha318 - Пятница, 16.02.2018, 12:19
 
Ответить
Сообщениеfan-vba, во вложении вложил ниже табличку со всеми параметрами что хочу обьединить. помогите пожалуйста

Автор - Sasha318
Дата добавления - 16.02.2018 в 12:19
Мир MS Excel » Вопросы и решения » Вопросы по VBA » переименовывание ячейки с данными и суммирование строк (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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