Объединить ячейки одного конкретного столбца, если равное значение

Мне нужно перебрать все строки (кроме строк заголовка) и объединить все ячейки с тем же значением в том же столбце. Прежде чем я это сделаю, я уже убедился, что столбец отсортирован. Итак, у меня есть такая настройка.Объединить ячейки одного конкретного столбца, если равное значение

a b c d e 
1 x x x x 
2 x x x x 
2 x x x x 
2 x x x x 
3 x x x x 
3 x x x x

И это нужно

a b c d e 
1 x x x x 
2 x x x x 
    x x x x 
    x x x x 
3 x x x x 
    x x x x

С моим кодом я достиг, чтобы объединить две равные клетки. Вместо этого мне нужно объединить все равные ячейки.

Dim i As Long 
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row 
    If Cells(i, 1) <> "" Then 
     If Cells(i, 1) = Cells(i - 1, 1) Then 
      Range(Cells(i, 1), Cells(i - 1, 1)).Merge 
     End If 
    End If 
Next i

источник

2015-05-10 gco

Важно, что код объединяет только ячейки в определенном столбце, а не все столбцы листа. – gco

Это должно сделать трюк ... 'Sub MergeColumnA() Dim я As Long Dim myLastRow As Long Application.DisplayAlerts = Ложные myLastRow = Cells (Rows.Count, "A"). End (xlUp) .Row Для i = myLastRow - от 1 до 6 Шаг -1 Если ячейки (i + 1, 1) <> "" Затем Если ячейки (i, 1) = ячейки (i + 1, 1) Затем диапазон (Клетки (я, 1), Cells (я + 1, 1)). Merge End If Далее я Application.DisplayAlerts = True End Sub' – gco

Этот метод не использует объединенные ячейки, но достигает того же визуальный эффект:

Say мы начинаем с:

enter image description here

Запуск этого макроса:

Sub HideDups() 
    Dim N As Long, i As Long 
    N = Cells(Rows.Count, "A").End(xlUp).Row 
    For i = N To 3 Step -1 
     With Cells(i, 1) 
      If .Value = Cells(i - 1, 1).Value Then 
       .Font.ColorIndex = 2 
      End If 
     End With 
    Next i 
End Sub

будет выдача результата:

enter image description here

Примечание:

клетки не объединяются. Этот визуальный эффект тот же, поскольку последовательные дубликаты в одном столбце «скрыты», если цвет шрифта совпадает с цветом фона ячейки.

источник

2015-05-10 12:30:39

Nice подхода. Я ценю. Имеет смысл, поскольку объединенные ячейки освобождают какую-то информацию и создают массу проблем для форматирования. – gco

@gco Я использую этот метод, когда мне приходится составлять отчет, который «похож» на сводную таблицу. –

Это потрясающе, и я обязательно буду использовать его в будущем. во всяком случае, моему сотруднику нужны объединенные ячейки (см. мой комментарий в моем вопросе для решения). – gco

Я знаю, что это старая нить, но мне нужно было что-то подобное. Вот что я придумал.

Sub MergeLikeCells()

Dim varTestVal As Variant 
Dim intRowCount As Integer 
Dim intAdjustment As Integer 

ActiveSheet.Range("A1").Select 
'Find like values in column A - Merge and Center Cells 
While Selection.Offset(1, 0).Value <> "" 
    intRowCount = 1 
    varTestVal = Selection.Value 
    While Selection.Offset(1, 0).Value = varTestVal 
     intRowCount = intRowCount + 1 
     Selection.Offset(1, 0).Select 
     Selection.ClearContents 
    Wend 
    intAdjustment = (intRowCount * -1) + 1 
    Selection.Offset(intAdjustment, 0).Select 
    Selection.Resize(intRowCount, 1).Select 
    With Selection 
     .Merge 
     .HorizontalAlignment = xlCenter 
     .VerticalAlignment = xlCenter 
    End With 
    Selection.Offset(1, 0).Resize(1, 1).Select 
Wend

End Sub

источник

2016-12-05 22:27:37 tlemaster

Объединить ячейки одного конкретного столбца, если равное значение

ответ

Смежные вопросы