column에서 같은 cell끼리 병합시키기(merge)

https://blog.naver.com/rosa0189/60210941614

(1628) 위아래 같은 값 셀병합 매크로 2 (엑셀 VBA 매크로)

 

 

 

**응용한것 위에는 열을 순환시키는데 밑에 코드는 열순환은 안함.

 

Sub 체화재고4_화주사셀병합()
'https://blog.naver.com/rosa0189/60210941614 출처에서  고쳐씀.
    Dim x As Long
    Dim r As Long                                                         '행(r)ow 늘려갈 변수
    Dim i As Long                                                         '동일 이름 중복개수 구할 변수
    
    With Sheets("보고서")                                                       '선택 영역에서
    r = 3
                                  '1부터 선택영역 열 개수만큼 반복
                
            Do
                
                r = r + 1                                                       '행을 1씩 증가
                
                If .Cells(r, 2) = .Cells(r + 1, 2) Then            '각 셀이 바로 아래 셀과 같으면
                    i = i + 1                                                   '중복개수를 하나씩 늘려감
                Else                                                            '각 셀이 바로 아래 셀과 다르면
        
                    If i > 0 Then                                            '중복이 있을 경우
                        Application.DisplayAlerts = False      '화면 경고 중지
                        .Cells(r - i, 2).Resize(i + 1, 1).Merge  '중복영역 셀병합
                        Application.DisplayAlerts = True        '화면 경고 복원
                    End If
                    
                    i = 0                                                         '재사용 위하여 초기화
                End If
            
            Loop Until r = .Cells(Rows.Count, "A").End(3).Row                            '선택영역 마지막 행까지 무한반복
            
            r = 0                                                                 '재사용 위하여 초기화
        
    End With

    MsgBox "매크로가 종료되었습니다."                      '종료 메시지창 출력
End Sub