'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=279757774
'
'안녕하세요.
'엑셀 관련 문의드립니다.
'첨부파일 "test.xls"의  B열(주문번호) 값을 기준으로
'동일한 값의 위아래에만 굵은 테두리를 넣으려면 어떤 방법이 있을까요?
'첨부파일 "test-테두리선작업.xls"처럼 작업되면 됩니다.
'자료가 1만건 이상인데 일일이 테두리선 넣기를 하다보니 너무 시간이 오래걸려서요.
'엑셀고수님께 조언 부탁드립니다.
'감사합니다.




'주문번호가 정렬되어 있다는 가정하에 아래의 코드를 수행하세요.
'
'source by 땡큐엑셀vba & 엑셀매크로
'
Sub 블럭별테두리()
    Dim 범위 As Range
    Dim Rng As Range
    
    
    '화면갱신 중지
    Application.ScreenUpdating = False
    
    마지막행 = Cells(Rows.Count, "A").End(xlUp).Row
    
    '이중루프를 사용함
    '2행부터 마지막행까지 루프
    For i = 2 To 마지막행
        '주문번호를 기준으로 비교
        주문번호 = Cells(i, "B")
        시작행 = Cells(i, "B").Row
        
        '같은 주문번호의 끝을 찾아 굵은 테두리 그리기
        For j = i To 마지막행
            다음주문번호 = Cells(j, "B")
            
            '같을경우 동일행 업데이트
            If 주문번호 = 다음주문번호 Then
                동일행 = Cells(j, "B").Row
            Else
                '주문번호가 다른값인 경우 테두리 그리기
                Set Rng = Range(시작행 & ":" & 동일행)

                '윗줄 굵은 테두리
                With Rng.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                
                '밑줄 굵은 테두리
                With Rng.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                
                
                i = j - 1
                Exit For
            End If
            
        Next j
        
    
    Next i
    
    
    '화면갱신 재계
    Application.ScreenUpdating = True
    
    
    MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"
    
End Sub