Страницы: 1
RSS
Помощь в доработке Макроса, Объединение ячеек по условию
 
Добрый день.
Прошу помочь реализовать объединение ячеек по условию...никак не могу сообразить как это сделать исходя из того кода макроса который, написал с горем пополам..
Данный Макрос Добавляет строку в таблицу исходя из введенных значений в специальную форму.
Необходимо что бы при добавлении новой строки происходило объединение строк и столбцов если добавляемые значения равны предыдущим.

Объединение по столбцам A,B,C,D,E
Объединение по строкам если значения равны в соседних ячейках:
-Группа 1 (SGI)  (столбцы F,G,H)
-Группа 2 (GAP) ( столбец I,J,K)

Условный пример как есть и как должно быть прикладываю.
БЮДЖЕТ 1000р

Код
Sub AddDataToTableMotivation()
Dim nextRow As Long
If Лист1.Range("date").Value = "" Or Лист1.Range("index").Value = "" Or Лист1.Range("tarif").Value = "" Or Лист1.Range("index").Value = "" Or Лист1.Range("type").Value = "" Or Лист1.Range("value").Value = "" Or Лист1.Range("value_to").Value = "" Or Лист1.Range("AV").Value = "" Or Лист1.Range("AV_2").Value = "" Then
MsgBox ("Заполните обязательные ячейки, выделенные желтым цветом")
End If
If Лист1.Range("date").Value = "" Or Лист1.Range("index").Value = "" Or Лист1.Range("tarif").Value = "" Or Лист1.Range("index").Value = "" Or Лист1.Range("type").Value = "" Or Лист1.Range("value").Value = "" Or Лист1.Range("value_to").Value = "" Or Лист1.Range("AV").Value = "" Then End
 
 
'Cсчитаем количество заполненных строк в таблице'
nextRow = Лист1.Cells(Лист1.Rows.Count, 2).End(xlUp).Offset(1, 0).Row
 
 
 
With Лист1
 
 
Лист1.Range("tarif").Copy
.Cells(nextRow, 1).Value = Лист1.Range("date").Value
.Cells(nextRow, 2).PasteSpecial Paste:=xlPasteValues
.Cells(nextRow, 3).Value = Лист1.Range("index").Value
If Лист1.Range("type").Value = "шт" Then
.Cells(nextRow, 4).Value = "от " & Лист1.Range("value").Value & " " & "до " & Лист1.Range("value_to").Value & " " & "шт"
Else
.Cells(nextRow, 4).Value = "от " & Лист1.Range("value").Value & " " & "до " & Лист1.Range("value_to").Value & " " & "млн.руб"
End If
If Лист1.Range("type").Value = "шт" Then
.Cells(nextRow, 5).Value = Лист1.Range("AV_2").Value
Else
.Cells(nextRow, 5).Value = Лист1.Range("AV").Value * 100 & "%"
End If
.Cells(nextRow, 6).Value = Лист1.Range("SGI_1").Value
.Cells(nextRow, 7).Value = Лист1.Range("SGI_2").Value
.Cells(nextRow, 8).Value = Лист1.Range("SGI_3").Value
.Cells(nextRow, 9).Value = Лист1.Range("GAP_1").Value
.Cells(nextRow, 10).Value = Лист1.Range("GAP_2").Value
.Cells(nextRow, 11).Value = Лист1.Range("GAP_3").Value
 
 
 
 
End With
 
 
End Sub
 
Пишу в личку для уточнения задачи.
В работе.
Готово.
Изменено: Юрий М - 09.06.2021 21:41:16
 
Спасибо Большое за решение!)
(Задача закрыта)
Изменено: sitro - 10.06.2021 11:46:14
Страницы: 1
Читают тему (гостей: 1)
Наверх