[엑셀] 동일 데이터 셀 병합하기

출처: 지식인

Sub 매크로2()
     Dim rngDb   As Range
     Dim rngCell As Range
   
     Application.DisplayAlerts = False
   
     With ActiveSheet
         Set rngDb = .Range("A2").Resize(.Range("A65536").End(xlUp).Row - 1)
         셀병합하기 rngDb
     End With
   
     Application.DisplayAlerts = True
   
     Set rngDb = Nothing
 End Sub

 

Private Sub 셀병합하기(rngTarget As Range)
     Dim rngCell As Range
     Dim intNum As Long
     Dim intCount As Long
     Dim intTemp2 As Long
     Dim intTemp As Long
     Dim i As Integer
   
     intNum = rngTarget.Cells.Count
   
     For Each rngCell In rngTarget
         intTemp = intTemp + 1
         intTemp2 = intNum - intTemp
          
         If Len(rngCell) > 0 Then
             i = 0
             For intCount = 1 To intTemp2
                 If rngCell.Offset(intCount, 0) = rngCell Then
                     i = i + 1
                 Else
                     Exit For
                 End If
             Next intCount
             If i > 0 Then
                 rngCell.Resize(i + 1).Merge
                 셀병합하기 rngCell.Offset(, 1).Resize(i + 1)
             End If
         End If
     Next rngCell
     rngTarget.VerticalAlignment = xlCenter
 End Sub

 

Option Explicit

Sub merge()

    With ActiveSheet
        Call 매크로2("D2", "D65536", 8)
    End With
End Sub

Sub 매크로2(FromCell, ToCell, EndColumn)
     Dim rngDb   As Range
     Dim rngCell As Range
   
     Application.DisplayAlerts = False
   
     With ActiveSheet
         Set rngDb = .Range(FromCell).Resize(.Range(ToCell).End(xlUp).Row - 1)
         Call 셀병합하기(rngDb, EndColumn)
     End With
   
     Application.DisplayAlerts = True
   
     Set rngDb = Nothing
 End Sub

 

Private Sub 셀병합하기(rngTarget As Range, EndColumn)
     Dim rngCell As Range
     Dim intNum As Long
     Dim intCount As Long
     Dim intTemp2 As Long
     Dim intTemp As Long
     Dim i As Integer
     Dim nextcolumn As Integer
    
   
     intNum = rngTarget.Cells.Count
   
     For Each rngCell In rngTarget
         intTemp = intTemp + 1
         intTemp2 = intNum - intTemp
          
         If Len(rngCell) > 0 Then
             i = 0
             For intCount = 1 To intTemp2
                 If rngCell.Offset(intCount, 0) = rngCell Then
                     i = i + 1
                 Else
                     Exit For
                 End If
             Next intCount
             If i > 0 Then
                 rngCell.Resize(i + 1).merge
                
                 nextcolumn = rngCell.Column
                
                 If nextcolumn <= (EndColumn - 1) Then
                    Call 셀병합하기(rngCell.Offset(, 1).Resize(i + 1), EndColumn)
                 End If
                
             End If
         End If
     Next rngCell
     rngTarget.VerticalAlignment = xlCenter
 End Sub