Объединение одинаковых ячеек в excel
Автор Fisben задал вопрос в разделе Другие языки и технологии
Нужен макрос в Excel, чтобы объединял ячейки в столбце если они одинаковые. Может кто помочь мне с этим ? написать?:) и получил лучший ответ
Ответ от Intro-nikol[гуру]
Давай помогу.
В агент стучись
intro-nikol
Мастер
(1668)
Есть
три два девять восемь два ноль девять восемь семь
Ответ от Ёергей Емелин[новичек]
Нет времени писать код и тестить, поэтому могу немного направить:
надо записать объединение ячеек через "Запись макроса", потом из записанного макроса извлечь часть кода, которая непосредственно выполняет объединение ячеек, затем если ты что-то понимаешь в условиях, циклах и переменных, ты сам сможешь задать цыкл для сравнения ячеек при определенос условии, удачи
Нет времени писать код и тестить, поэтому могу немного направить:
надо записать объединение ячеек через "Запись макроса", потом из записанного макроса извлечь часть кода, которая непосредственно выполняет объединение ячеек, затем если ты что-то понимаешь в условиях, циклах и переменных, ты сам сможешь задать цыкл для сравнения ячеек при определенос условии, удачи
Ответ от Ottvett[гуру]
А что вы имеете в виду под "одинаковые"? Одного цвета или одного размера? :))
Если с одинаковыми значениями, то:
Sub zzMerge() '' с УЖЕ объединенными ячейкми НЕ работает
Dim i As Long, NumCol As Long, NumTopRow As Long, NumBotRow As Long
NumCol = 1 ' № столбца
NumTopRow = 1 ' № верхней строки, с которой начинать поиск
NumBotRow = Cells(Rows.Count, NumCol).End(xlUp).Row - 1 ' № нижней строки, на которой заканчивать поиск
'или указать, что надо
For i = NumTopRow To NumBotRow - 1
If Cells(i, NumCol) <> "" Then
If Cells(i, NumCol) = Cells(i + 1, NumCol) Then
Range(Cells(i, NumCol), Cells(i + 1, NumCol)).Select
Selection.Merge
End If
End If
Next i
End Sub
А что вы имеете в виду под "одинаковые"? Одного цвета или одного размера? :))
Если с одинаковыми значениями, то:
Sub zzMerge() '' с УЖЕ объединенными ячейкми НЕ работает
Dim i As Long, NumCol As Long, NumTopRow As Long, NumBotRow As Long
NumCol = 1 ' № столбца
NumTopRow = 1 ' № верхней строки, с которой начинать поиск
NumBotRow = Cells(Rows.Count, NumCol).End(xlUp).Row - 1 ' № нижней строки, на которой заканчивать поиск
'или указать, что надо
For i = NumTopRow To NumBotRow - 1
If Cells(i, NumCol) <> "" Then
If Cells(i, NumCol) = Cells(i + 1, NumCol) Then
Range(Cells(i, NumCol), Cells(i + 1, NumCol)).Select
Selection.Merge
End If
End If
Next i
End Sub
Ответ от 3 ответа[гуру]
Привет! Вот подборка тем с похожими вопросами и ответами на Ваш вопрос: Нужен макрос в Excel, чтобы объединял ячейки в столбце если они одинаковые. Может кто помочь мне с этим ? написать?:)