사용중인 매크로들 170809

Posted on by ehrok

반복적인 작업은 매크로를 세팅해놓으면 도움이 된다. 전체자동화보다는 각각 사용할수 있게 모듈로 나누어놓는게 나은듯

절대참조, 상대참조를 이해하고 간단하게 기록한 다음 불필요한 구문을 삭제,수정하면 된다.

(code를 포스팅 할경우 ``` 는   의 형식을 갖게 되고, <pre> </pre>는 제일 하단 서식의 형식을 갖게된다.

입찰대비표 data

1. 양식변환

<br />Sub 입찰대비표()
'
' 입찰대비표 매크로
'

'
    Columns("H:I").Select
    Range("I1").Activate
    Selection.EntireColumn.Hidden = True
    Rows("4:5").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A6").Select
    ActiveWindow.DisplayZeros = False
End Sub

2. 비율등 입력

<br />Sub 합계1위3칸아래에서실행()
'
' 합계1위3칸아래에서실행 매크로
'

'
    ActiveCell.FormulaR1C1 = "=R[-3]C/R[-3]C[-10]"
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-5]C[-10]-R[-5]C"
    ActiveCell.Offset(-2, 8).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C/R[-3]C[-18]"
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-5]C[-18]-R[-5]C"
    ActiveCell.Offset(-2, 8).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C/R[-3]C[-26]"
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-5]C[-26]-R[-5]C"
    ActiveCell.Offset(-2, 8).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C/R[-3]C[-34]"
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-5]C[-34]-R[-5]C"
    ActiveCell.Offset(-2, 8).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-3]C/R[-3]C[-42]"
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[-5]C[-42]-R[-5]C"
    ActiveCell.Offset(-2, 0).Rows("1:1").EntireRow.Select
    Selection.Style = "Percent"
    Selection.NumberFormatLocal = "0.0%"
    ActiveCell.Select
    Range("F6").Select
    ActiveWindow.FreezePanes = True
End Sub

분석 및 서식 추가 필요

자주쓰는 것들

날짜의 경우는 data 함수를 사용해서 yy, mm, dd 를 지정해주는 방법이 더 나았다.

<br />Sub zero()
'
' zero 매크로
'

'
    ActiveWindow.DisplayZeros = False
End Sub

Sub 사업자번호양식10자리()
'
' 사업자번호양식10자리 매크로
'

'
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],3)&-MID(RC[-1],4,2)&-RIGHT(RC[-1],5)"

End Sub


Sub 날짜8자리변환()
'
' 날짜8자리변환 매크로
'

'
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],4)&-MID(RC[-1],5,2)&-RIGHT(RC[-1],2)"

End Sub

출력

출력시 하단에 파일명, 탭명, 페이지 입력

<br />'
' PRINT_A3 매크로
'

'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftFooter = "&F"
        .CenterFooter = "&A"
        .RightFooter = "&P / &N"
        .Orientation = xlLandscape
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With
    Application.PrintCommunication = True
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$4:$5"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = "&F"
        .CenterFooter = "&A"
        .RightFooter = "&P / &N"
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    Application.PrintCommunication = True
    Range("A2").Select
End Sub

출력 두번째

Sub setting_printer()
'
' setting_printer 매크로
'

'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$4:$5"
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = "&F"
        .CenterFooter = "&A"
        .RightFooter = "&P / &N"
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
End Sub

같은 값 위아래 셀 합치기

매크로 (출처: seekseek 블로그)


Sub mergecell()
'
' AutoMerge Macro
'
' 바로 가기 키: Ctrl+k
'
On Error Resume Next
'ActiveCell.Select
rowcnt = ActiveCell.Row
colcnt = ActiveCell.Column
a = Cells(rowcnt, colcnt).Value
rowcnt2 = rowcnt + 1

'빈칸이면 끝
While Cells(rowcnt2, colcnt).Value  ""
    While a = Cells(rowcnt2, colcnt).Value '같은 값이면 계속증가
       Cells(rowcnt2, colcnt).Value = "" '같으니까 값을 지워주자 ㅎㅎㅎ
       '그래야 값이 둘인데 하나는 없어진다는 메시지 창이 뜨지 않는다.
       rowcnt2 = rowcnt2 + 1
    Wend
       '이제 같은 값구역을 병합
       Range(Cells(rowcnt, colcnt), Cells(rowcnt2 - 1, colcnt)).Select

       With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Merge (False)
        
        '초기화

        rowcnt = rowcnt2
        a = Cells(rowcnt, colcnt).Value
        rowcnt2 = rowcnt + 1
Wend
'
End Sub