컴퓨터/엑셀

vba 공백행지우기

풍경소리^^ 2018. 6. 14. 17:48

Sub unMerge_and_Fill()

    Dim rngC As Range                              '선택영역 각 셀을 넣을 변수
    Dim r As Long                                      '카운터로 사용할 변수
Dim rng As Range
Dim rowsCnt As Integer
    rowsCnt = Cells(Rows.Count, "a").End(3).Row
    Set rng = Range(Cells(1, "a"), Cells(rowsCnt, "a"))
    Set rngC = rng
    rngC.Select
    Application.ScreenUpdating = False       '화면 업데이트 중지

 

'    With Selection
'        If .Cells.Count = 1 Then                    '한 셀만 선택 시 매크로 중지
'            MsgBox "한 셀만 선택함. 영역 재설정 후 실행", 64, "영역설정 오류"
'            Exit Sub                                     '매크로 중단
'        End If
'    End With


    For Each rngC In Selection                   '선택 영역을 순환
        If rngC.MergeCells Then                   '만일 선택셀이 셀병합 되어 있다면
            With rngC.MergeArea                   '셀병합된 area를
                .UnMerge                               '셀병합을 풀고
                If InStr(rngC, "(") > 0 Then
                    .Value = Left(rngC, InStr(rngC, "(") - 2)               '셀병합 풀린영역 셀병합전 값으로 채움
                Else
                    .Value = rngC
                End If
               
            End With

            r = r + 1                                       '카운터를 1씩 늘려감
        End If
    Next

'    If r > 0 Then
'        MsgBox "전체 " & r & "개의 셀병합된 셀을 풀고 복사했음"
'    Else
'        MsgBox "선택 영역내에 병합된 셀이 없음.", vbInformation, "병합된셀 없음"
'        Exit Sub
'    End If
    공백행지우기
    
End Sub


Sub 공백행지우기()
Dim rng As Range
Dim rowsCnt As Integer
    rowsCnt = Cells(Rows.Count, "a").End(3).Row
    Set rng = Range(Cells(1, "a"), Cells(rowsCnt, "f"))

    Dim i As Long                                                  '반복구문에 사용할 변수
 

    Application.ScreenUpdating = False                    '화면 업데이트 (일시)중지
    rng.Select
    With Selection                                                  '선택 영역에서
        For i = .Rows.Count To 1 Step -1                    '마지막 행부터 1씩 줄여가며 반복
       
            If Cells(i, "d") = "" Or Cells(i, "d") = "총 매 출" Then
                                                                          '전체행이 비어 있을 경우
                .Rows(i).Delete Shift:=xlUp
                                                                          '공백행과 아래행을 삭제
            End If
           
        Next i
    End With
End Sub

'컴퓨터 > 엑셀' 카테고리의 다른 글

범위중 첫번째셀주소  (0) 2018.06.16
엑셀 동적범위 이용한 사진검색-이름정의 =picture  (0) 2018.06.15
반복인쇄  (0) 2018.06.07
vba 행번호매기기  (0) 2018.06.06
vba countif 함수 현재행  (0) 2018.06.06