VBA 와 MYSQL 연동을 위한 준비

엑셀에서 직접 MYSQL DB 에 있는 데이터를 불러오는 방법입니다.

'VBA SQL 연동' 이라고 검색해서 찾아보셔도 됩니다.

가장 먼저 해야 할 사항은 MySQL Connector ODBC 5.1

파일을 설치하는 겁니다.

mysql-connector-odbc-5.1.8-win32.msi

** 최신버전(5.3X)을 받아서 파일 업로드는 했는데 ODBC 드라이버 세팅할 줄을 몰라서 이걸로 하면 동작이 안되네요. 해결방법을 찾으면 업데이트 하겠습니다.

mysql-connector-odbc-5.3.4-win32.msi

mysql-connector-odbc-5.3.4-winx64.msi

위 파일을 다운로드 받아서 실행하세요.

다음(Next)를 눌러주기만 하면 설치가 완료됩니다.

제어판에서 설치된 것을 확인해 봅니다.

설치되어 있는 것을 확인했습니다.

이제 엑셀을 띄워서 VBA 에서 확인을 합니다.

위와 같이 체크되어 있는지 확인을 합니다.

VBA 파일내에서 위와 같이 여러개의 값이 설정되어 있어야 합니다.

그리고 반드시 MYSQL 원격접속이 허용되어 있어야만 가능합니다.

보통은 보안상의 설정 때문에 localhost 로 설정되어 있습니다.

이제부터는 VBA 코드에 연결할 작업을 해야 합니다.

http://link2me.tistory.com/422 참조하세요

날씨정보 추출

아래 코드는 다음의 날씨 정보를 편하게 추출하는 VBA 코드입니다.

http://weather.media.daum.net/ 접속하여 아래처럼 합니다.

엑셀 시트에 붙여넣기를 합니다.

테스트해보니 한가지 버그사항은 날짜를 가져오는데 년도를 올해 연도로 잘못인식하는 증상이 있네요..

위 그림에 보면 날짜는 있고 연도는 없다보니 연도를 올해 연도로 인식해서 그냥 붙여버리는 증상이 있다는 겁니다. 그점을 감안하여 추출한 다음에 연도는 수정을 해주는게 필요합니다.

첨부한 엑셀파일에 필요한 VBA Code 는 다 들어 있습니다.

테스트를 해보니 익스플로러와 크롬 브라우저, Firefox 브라우저가 인식하는 값이 다른 거 같네요..

그래서 두가지 버전으로 별도로 올립니다.

날씨추출_익스와크롬.xlsm

날씨추출_Firefox.xlsm

Sub 날씨정보추출()
    Dim Dat As Variant
    ReDim Dat(1 To 6, 1 To 1)
    Dim i As Integer, n As Integer, Day As Integer
    On Error Resume Next
    With ActiveSheet
        .Cells.Hyperlinks.Delete    '// 하이퍼링크 제거
        For i = 2 To 52 Step 10     '// 날짜가 표시된 셀 선택
            For n = 1 To 7          '// 일 ~ 토요일까지 선택
                If Not IsEmpty(.Cells(i, n)) Then   '// .Cells(i,n)은 현재셀이 비어있지 않으면
                    Day = Day + 1   '// Day은 날짜수만큼 증가, 배열을 늘려갈 변수에 1을 더함
                    ReDim Preserve Dat(1 To 6, 1 To Day)  '// 동적배열 변수의 저장공간을 다시 할당
                    Dat(1, Day) = .Cells(i, n)    '// 날짜
                    Dat(2, Day) = .Cells(i, n).Offset(3)    '// 날씨
                    Dat(3, Day) = Mid(.Cells(i, n).Offset(5), 4, 20)  '// 최저기온
                    Dat(4, Day) = Mid(.Cells(i, n).Offset(6), 4, 20)    '// 최고기온
                    Dat(5, Day) = Mid(.Cells(i, n).Offset(7), 5, 20)    '// 강수량
                    Dat(6, Day) = Mid(.Cells(i, n).Offset(8), 5, 20)    '// 적설량
                End If
            Next n
        Next i
        With .Cells(2, "J") '// 지정한 셀에 대해서
            .Resize(Rows.Count - 1, 6).Clear   '// 기존값 제거
            .Resize(UBound(Dat, 2), UBound(Dat, 1)) = Application.Transpose(Dat)   

             '// 배열의 행과 열을 바꾸어 값을 넣음
        End With
    End With
   
    Range([J2], Cells(Rows.Count, "J").End(3)).NumberFormat = "yyyy-mm-dd"          '// 날짜 서식으로 지정
    Range([J2], Cells(Rows.Count, "O").End(3)).HorizontalAlignment = xlCenter       '// 중앙정렬
  
End Sub

도움되셨다면 공감 꾸욱 눌러주시거나 댓글 부탁드립니다.

한 시트 파일을 여러개로 나눠 저장

엑셀을 다루다보면 한 시트의 파일을 여러개로 나눠서 저장할 일이 있습니다.

아래 첨부파일을 다운로드 받아서 복사하여 이용하면 됩니다.

Split_Rows.vbs

Sub split_As_per_Rows()
    '// 지정한 행만큼씩 파일을 나눠서 저장하는 VBA
    Dim Counter
    Dim rngAll As Range                           '//모든 영역을 저장할 변수
    Dim SplitLine As Integer                      '//몇 행씩 나눌지를 정하는 변수
    Dim rowsCount As Long, colsCount As Integer   '//행 및 열의 갯수 저장할 변수
    Dim strPath As String                         '//파일저장 경로를 넣을 변수
    Dim i As Long                                 '//반복구문 숫자 증가에 사용할 변수
    Dim rowsNo As Long                            '//행 증가에 사용할 변수
    Dim rngSplit As Range                         '//나누어진 영역을 저장할 변수
    Dim strName As String
   
    Counter = InputBox("분할할 행의 수 입력하세요")
    If Counter = "" Then Exit Sub           '// 취소 선택시 매크로 중단
    If Not IsNumeric(Counter) Then Exit Sub '// 입력한 값이 숫자가 아닌 경우

    Application.ScreenUpdating = False      '//화면 업데이트 (일시)정지
    Set rngAll = ActiveSheet.UsedRange      '//사용전체영역을 변수에 넣음
    SplitLine = Counter                     '// 입력한 숫자 만큼 파일이 나눠서 저장
    rowsCount = rngAll.Rows.Count           '//전체 행의 숫자를 행 변수에 넣음
    colsCount = rngAll.Columns.Count        '//전체 열의 숫자를 열 변수에 넣음
    strPath = ThisWorkbook.Path & Application.PathSeparator   '//현재 파일이 있는 경로에 저장

    With ThisWorkbook
      strName = Left(.Name, Len(.Name) - 5)  '//Excel 파일의 확장자 제거. 만약 xls 파일이면 숫자를 4로 변경
    End With

    For i = 2 To rowsCount Step SplitLine                                     '//SplitLine 만큼씩 증가하며 반복
        rowsNo = i + SplitLine                                                 '//행도 지정한 SplitLine 만큼씩 증가
        Set rngSplit = Range(Cells(i, 1), Cells(rowsNo + 1, colsCount))         '//나누어진 영역을 변수에 넣음
        Workbooks.Add                                                         '//새로운 workbook을 생성
        rngAll.Rows(1).SpecialCells(2).Copy Cells(1, 1)                         '//첫줄 제목을 각 workbook에 복사
        Range(Cells(2, 1), Cells(SplitLine + 1, colsCount)) = rngSplit.Value

          '//2번째 행부터 나누어진 영역(SplitLine 만큼)을 복사
        Columns.AutoFit  '//열너비 자동맞춤
        ActiveWorkbook.SaveAs strPath & strName & "(" & ((i - 1) \ SplitLine) + 1 & ").xlsx", FileFormat:=xlOpenXMLWorkbook
                     '//현재 파일이 있는 경로에 현재파일명 + SplitLine 만큼씩 나눠서 몫으로 카운트하면서 저장
        ActiveWorkbook.Close   '//새로 만든 workbook을 저장
    Next i

    Set rngAll = Nothing     '//개체변수들 초기화(사용 메모리 비우기)
    Set rngSplit = Nothing
End Sub

전화번호 다루기

전화번호는 02,031 과 같은 유선전화번호와 010, 011, 016 과 같은 휴대폰번호, 070 인터넷전화번호, 1588, 1544와 같은 지능망번호, 특수번호 112, 119, 131 등이 있습니다.

아래 코드는 전체를 다 보기 편하게 분류할 순 없고 휴대폰, 유선번호, 인터넷번호만 편하게 정리하도록 했습니다.

휴대폰 번호만 보기좋게 정렬하고자 한다면 .....

=IF(LEN(SUBSTITUTE(A1,"-",""))=11,TEXT(SUBSTITUTE(A1,"-",""),"000-0000-0000"),TEXT(SUBSTITUTE(A1,"-",""),"000-000-0000"))

중간에 - 가 들어가 있는 경우에도 모두 공백으로 지우고 나서 TEXT 정렬을 합니다.

Sub 전화번호정리()
    Dim rngAll  As Range
    Dim rngC    As Range
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    ActiveCell.Select       '// 현재셀이 위치한 곳
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))     
    'Set rngAll = Selection     '// 선택된 범위만 지정하려고 할 때
    For Each rngC In rngAll
        Select Case Len(rngC)
            Case 8
                rngC.Offset(0, 1).Value = Format(rngC.Value, "0000-0000")
            Case 9
                rngC.Offset(0, 1).Value = Format(rngC.Value, "00-000-0000")
            Case 10
                If Left(rngC, 2) = "02" Then
                    rngC.Offset(0, 1).Value = Format(rngC.Value, "00-0000-0000")
                Else
                    rngC.Offset(0, 1).Value = Format(rngC.Value, "000-000-0000")
                End If
            Case 11
                rngC.Offset(0, 1).Value = Format(rngC.Value, "000-0000-0000")
        End Select
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "완료"

End Sub

음력 - 양력 변환 VBA

출처 : http://pheelfree.tistory.com/57

sol2lunar.vbs

Option Explicit

Dim EM(1 To 130, 1 To 13) As Integer, MT(12) As Integer

Dim VM(6) As Integer

Dim CY As Integer, CM As Integer, CD As Integer, CA As Boolean

Sub CalenderData()

    'mt(12) 배열은 양력각달의 크기를 누적합산한 값을 저장한 것임(평년기준, 즉 1년 365일)

    MT(1) = 31: MT(2) = 59: MT(3) = 90: MT(4) = 120: MT(5) = 151: MT(6) = 181: MT(7) = 212: MT(8) = 243: MT(9) = 273: MT(10) = 304: MT(11) = 334: MT(12) = 365

    'VM(6) 배열은 1과 2는 음력각달의 크기를 3~6은 윤달과같은달의 크기와 윤달의크기를 합한값을 저장한 것임

    VM(1) = 29: VM(2) = 30: VM(3) = 29 + 29: VM(4) = 29 + 30: VM(5) = 30 + 29: VM(6) = 30 + 30

    'EM(?,?) 배열은 1901년부터 2030년까지의 음력 각달의 크기를 VM(6) 배열값으로 저장하고 마지막 배열은 음력 총일수를 저장함

    EM(1, 1) = 1: EM(1, 2) = 2: EM(1, 3) = 1: EM(1, 4) = 1: EM(1, 5) = 2: EM(1, 6) = 1: EM(1, 7) = 2: EM(1, 8) = 1: EM(1, 9) = 2: EM(1, 10) = 2: EM(1, 11) = 2: EM(1, 12) = 1: EM(1, 13) = 354               '1901년

    EM(2, 1) = 2: EM(2, 2) = 1: EM(2, 3) = 2: EM(2, 4) = 1: EM(2, 5) = 1: EM(2, 6) = 2: EM(2, 7) = 1: EM(2, 8) = 2: EM(2, 9) = 1: EM(2, 10) = 2: EM(2, 11) = 2: EM(2, 12) = 2: EM(2, 13) = 355               '1902년

    EM(3, 1) = 1: EM(3, 2) = 2: EM(3, 3) = 1: EM(3, 4) = 2: EM(3, 5) = 3: EM(3, 6) = 2: EM(3, 7) = 1: EM(3, 8) = 1: EM(3, 9) = 2: EM(3, 10) = 2: EM(3, 11) = 1: EM(3, 12) = 2: EM(3, 13) = 383               '1903년

    EM(4, 1) = 2: EM(4, 2) = 2: EM(4, 3) = 1: EM(4, 4) = 2: EM(4, 5) = 1: EM(4, 6) = 1: EM(4, 7) = 2: EM(4, 8) = 1: EM(4, 9) = 1: EM(4, 10) = 2: EM(4, 11) = 2: EM(4, 12) = 1: EM(4, 13) = 354               '1904년

    EM(5, 1) = 2: EM(5, 2) = 2: EM(5, 3) = 1: EM(5, 4) = 2: EM(5, 5) = 2: EM(5, 6) = 1: EM(5, 7) = 1: EM(5, 8) = 2: EM(5, 9) = 1: EM(5, 10) = 2: EM(5, 11) = 1: EM(5, 12) = 2: EM(5, 13) = 355               '1905년

    EM(6, 1) = 1: EM(6, 2) = 2: EM(6, 3) = 2: EM(6, 4) = 4: EM(6, 5) = 1: EM(6, 6) = 2: EM(6, 7) = 1: EM(6, 8) = 2: EM(6, 9) = 1: EM(6, 10) = 2: EM(6, 11) = 1: EM(6, 12) = 2: EM(6, 13) = 384               '1906년

    EM(7, 1) = 1: EM(7, 2) = 2: EM(7, 3) = 1: EM(7, 4) = 2: EM(7, 5) = 1: EM(7, 6) = 2: EM(7, 7) = 2: EM(7, 8) = 1: EM(7, 9) = 2: EM(7, 10) = 1: EM(7, 11) = 2: EM(7, 12) = 1: EM(7, 13) = 354               '1907년

    EM(8, 1) = 2: EM(8, 2) = 1: EM(8, 3) = 1: EM(8, 4) = 2: EM(8, 5) = 2: EM(8, 6) = 1: EM(8, 7) = 2: EM(8, 8) = 1: EM(8, 9) = 2: EM(8, 10) = 2: EM(8, 11) = 1: EM(8, 12) = 2: EM(8, 13) = 355               '1908년

    EM(9, 1) = 1: EM(9, 2) = 5: EM(9, 3) = 1: EM(9, 4) = 2: EM(9, 5) = 1: EM(9, 6) = 2: EM(9, 7) = 1: EM(9, 8) = 2: EM(9, 9) = 2: EM(9, 10) = 2: EM(9, 11) = 1: EM(9, 12) = 2: EM(9, 13) = 384               '1909년

    EM(10, 1) = 1: EM(10, 2) = 2: EM(10, 3) = 1: EM(10, 4) = 1: EM(10, 5) = 2: EM(10, 6) = 1: EM(10, 7) = 2: EM(10, 8) = 1: EM(10, 9) = 2: EM(10, 10) = 2: EM(10, 11) = 2: EM(10, 12) = 1: EM(10, 13) = 354  '1910년

    EM(11, 1) = 2: EM(11, 2) = 1: EM(11, 3) = 2: EM(11, 4) = 1: EM(11, 5) = 1: EM(11, 6) = 5: EM(11, 7) = 1: EM(11, 8) = 2: EM(11, 9) = 2: EM(11, 10) = 1: EM(11, 11) = 2: EM(11, 12) = 2: EM(11, 13) = 384  '1911년

    EM(12, 1) = 2: EM(12, 2) = 1: EM(12, 3) = 2: EM(12, 4) = 1: EM(12, 5) = 1: EM(12, 6) = 2: EM(12, 7) = 1: EM(12, 8) = 1: EM(12, 9) = 2: EM(12, 10) = 2: EM(12, 11) = 1: EM(12, 12) = 2: EM(12, 13) = 354  '1912년

    EM(13, 1) = 2: EM(13, 2) = 2: EM(13, 3) = 1: EM(13, 4) = 2: EM(13, 5) = 1: EM(13, 6) = 1: EM(13, 7) = 2: EM(13, 8) = 1: EM(13, 9) = 1: EM(13, 10) = 2: EM(13, 11) = 1: EM(13, 12) = 2: EM(13, 13) = 354  '1913년

    EM(14, 1) = 2: EM(14, 2) = 2: EM(14, 3) = 1: EM(14, 4) = 2: EM(14, 5) = 5: EM(14, 6) = 1: EM(14, 7) = 2: EM(14, 8) = 1: EM(14, 9) = 2: EM(14, 10) = 1: EM(14, 11) = 1: EM(14, 12) = 2: EM(14, 13) = 384  '1914년

    EM(15, 1) = 2: EM(15, 2) = 1: EM(15, 3) = 2: EM(15, 4) = 2: EM(15, 5) = 1: EM(15, 6) = 2: EM(15, 7) = 1: EM(15, 8) = 2: EM(15, 9) = 1: EM(15, 10) = 2: EM(15, 11) = 1: EM(15, 12) = 2: EM(15, 13) = 355  '1915년

    EM(16, 1) = 1: EM(16, 2) = 2: EM(16, 3) = 1: EM(16, 4) = 2: EM(16, 5) = 1: EM(16, 6) = 2: EM(16, 7) = 2: EM(16, 8) = 1: EM(16, 9) = 2: EM(16, 10) = 1: EM(16, 11) = 2: EM(16, 12) = 1: EM(16, 13) = 354  '1916년

    EM(17, 1) = 2: EM(17, 2) = 3: EM(17, 3) = 2: EM(17, 4) = 1: EM(17, 5) = 2: EM(17, 6) = 2: EM(17, 7) = 1: EM(17, 8) = 2: EM(17, 9) = 2: EM(17, 10) = 1: EM(17, 11) = 2: EM(17, 12) = 1: EM(17, 13) = 384  '1917년

    EM(18, 1) = 2: EM(18, 2) = 1: EM(18, 3) = 1: EM(18, 4) = 2: EM(18, 5) = 1: EM(18, 6) = 2: EM(18, 7) = 1: EM(18, 8) = 2: EM(18, 9) = 2: EM(18, 10) = 2: EM(18, 11) = 1: EM(18, 12) = 2: EM(18, 13) = 355  '1918년

    EM(19, 1) = 1: EM(19, 2) = 2: EM(19, 3) = 1: EM(19, 4) = 1: EM(19, 5) = 2: EM(19, 6) = 1: EM(19, 7) = 5: EM(19, 8) = 2: EM(19, 9) = 2: EM(19, 10) = 1: EM(19, 11) = 2: EM(19, 12) = 2: EM(19, 13) = 384  '1919년

    EM(20, 1) = 1: EM(20, 2) = 2: EM(20, 3) = 1: EM(20, 4) = 1: EM(20, 5) = 2: EM(20, 6) = 1: EM(20, 7) = 1: EM(20, 8) = 2: EM(20, 9) = 2: EM(20, 10) = 1: EM(20, 11) = 2: EM(20, 12) = 2: EM(20, 13) = 354  '1920년

    EM(21, 1) = 2: EM(21, 2) = 1: EM(21, 3) = 2: EM(21, 4) = 1: EM(21, 5) = 1: EM(21, 6) = 2: EM(21, 7) = 1: EM(21, 8) = 1: EM(21, 9) = 2: EM(21, 10) = 1: EM(21, 11) = 2: EM(21, 12) = 2: EM(21, 13) = 354  '1921년

    EM(22, 1) = 2: EM(22, 2) = 1: EM(22, 3) = 2: EM(22, 4) = 2: EM(22, 5) = 3: EM(22, 6) = 2: EM(22, 7) = 1: EM(22, 8) = 1: EM(22, 9) = 2: EM(22, 10) = 1: EM(22, 11) = 2: EM(22, 12) = 2: EM(22, 13) = 384  '1922년

    EM(23, 1) = 1: EM(23, 2) = 2: EM(23, 3) = 2: EM(23, 4) = 1: EM(23, 5) = 2: EM(23, 6) = 1: EM(23, 7) = 2: EM(23, 8) = 1: EM(23, 9) = 2: EM(23, 10) = 1: EM(23, 11) = 1: EM(23, 12) = 2: EM(23, 13) = 354  '1923년

    EM(24, 1) = 2: EM(24, 2) = 1: EM(24, 3) = 2: EM(24, 4) = 1: EM(24, 5) = 2: EM(24, 6) = 2: EM(24, 7) = 1: EM(24, 8) = 2: EM(24, 9) = 1: EM(24, 10) = 2: EM(24, 11) = 1: EM(24, 12) = 1: EM(24, 13) = 354  '1924년

    EM(25, 1) = 2: EM(25, 2) = 1: EM(25, 3) = 2: EM(25, 4) = 5: EM(25, 5) = 2: EM(25, 6) = 1: EM(25, 7) = 2: EM(25, 8) = 2: EM(25, 9) = 1: EM(25, 10) = 2: EM(25, 11) = 1: EM(25, 12) = 2: EM(25, 13) = 385  '1925년

    EM(26, 1) = 1: EM(26, 2) = 1: EM(26, 3) = 2: EM(26, 4) = 1: EM(26, 5) = 2: EM(26, 6) = 1: EM(26, 7) = 2: EM(26, 8) = 2: EM(26, 9) = 1: EM(26, 10) = 2: EM(26, 11) = 2: EM(26, 12) = 1: EM(26, 13) = 354  '1926년

    EM(27, 1) = 2: EM(27, 2) = 1: EM(27, 3) = 1: EM(27, 4) = 2: EM(27, 5) = 1: EM(27, 6) = 2: EM(27, 7) = 1: EM(27, 8) = 2: EM(27, 9) = 2: EM(27, 10) = 1: EM(27, 11) = 2: EM(27, 12) = 2: EM(27, 13) = 355  '1927년

    EM(28, 1) = 1: EM(28, 2) = 5: EM(28, 3) = 1: EM(28, 4) = 2: EM(28, 5) = 1: EM(28, 6) = 1: EM(28, 7) = 2: EM(28, 8) = 2: EM(28, 9) = 1: EM(28, 10) = 2: EM(28, 11) = 2: EM(28, 12) = 2: EM(28, 13) = 384  '1928년

    EM(29, 1) = 1: EM(29, 2) = 2: EM(29, 3) = 1: EM(29, 4) = 1: EM(29, 5) = 2: EM(29, 6) = 1: EM(29, 7) = 1: EM(29, 8) = 2: EM(29, 9) = 1: EM(29, 10) = 2: EM(29, 11) = 2: EM(29, 12) = 2: EM(29, 13) = 354  '1929년

    EM(30, 1) = 1: EM(30, 2) = 2: EM(30, 3) = 2: EM(30, 4) = 1: EM(30, 5) = 1: EM(30, 6) = 5: EM(30, 7) = 1: EM(30, 8) = 2: EM(30, 9) = 1: EM(30, 10) = 2: EM(30, 11) = 2: EM(30, 12) = 1: EM(30, 13) = 383  '1930년

    EM(31, 1) = 2: EM(31, 2) = 2: EM(31, 3) = 2: EM(31, 4) = 1: EM(31, 5) = 1: EM(31, 6) = 2: EM(31, 7) = 1: EM(31, 8) = 1: EM(31, 9) = 2: EM(31, 10) = 1: EM(31, 11) = 2: EM(31, 12) = 1: EM(31, 13) = 354  '1931년

    EM(32, 1) = 2: EM(32, 2) = 2: EM(32, 3) = 2: EM(32, 4) = 1: EM(32, 5) = 2: EM(32, 6) = 1: EM(32, 7) = 2: EM(32, 8) = 1: EM(32, 9) = 1: EM(32, 10) = 2: EM(32, 11) = 1: EM(32, 12) = 2: EM(32, 13) = 355  '1932년

    EM(33, 1) = 1: EM(33, 2) = 2: EM(33, 3) = 2: EM(33, 4) = 1: EM(33, 5) = 6: EM(33, 6) = 1: EM(33, 7) = 2: EM(33, 8) = 1: EM(33, 9) = 2: EM(33, 10) = 1: EM(33, 11) = 1: EM(33, 12) = 2: EM(33, 13) = 384  '1933년

    EM(34, 1) = 1: EM(34, 2) = 2: EM(34, 3) = 1: EM(34, 4) = 2: EM(34, 5) = 2: EM(34, 6) = 1: EM(34, 7) = 2: EM(34, 8) = 2: EM(34, 9) = 1: EM(34, 10) = 2: EM(34, 11) = 1: EM(34, 12) = 2: EM(34, 13) = 355  '1934년

    EM(35, 1) = 1: EM(35, 2) = 1: EM(35, 3) = 2: EM(35, 4) = 1: EM(35, 5) = 2: EM(35, 6) = 1: EM(35, 7) = 2: EM(35, 8) = 2: EM(35, 9) = 1: EM(35, 10) = 2: EM(35, 11) = 2: EM(35, 12) = 1: EM(35, 13) = 354  '1935년

    EM(36, 1) = 2: EM(36, 2) = 1: EM(36, 3) = 4: EM(36, 4) = 1: EM(36, 5) = 2: EM(36, 6) = 1: EM(36, 7) = 2: EM(36, 8) = 1: EM(36, 9) = 2: EM(36, 10) = 2: EM(36, 11) = 2: EM(36, 12) = 1: EM(36, 13) = 384  '1936년

    EM(37, 1) = 2: EM(37, 2) = 1: EM(37, 3) = 1: EM(37, 4) = 2: EM(37, 5) = 1: EM(37, 6) = 1: EM(37, 7) = 2: EM(37, 8) = 1: EM(37, 9) = 2: EM(37, 10) = 2: EM(37, 11) = 2: EM(37, 12) = 1: EM(37, 13) = 354  '1937년

    EM(38, 1) = 2: EM(38, 2) = 2: EM(38, 3) = 1: EM(38, 4) = 1: EM(38, 5) = 2: EM(38, 6) = 1: EM(38, 7) = 4: EM(38, 8) = 1: EM(38, 9) = 2: EM(38, 10) = 2: EM(38, 11) = 1: EM(38, 12) = 2: EM(38, 13) = 384  '1938년

    EM(39, 1) = 2: EM(39, 2) = 2: EM(39, 3) = 1: EM(39, 4) = 1: EM(39, 5) = 2: EM(39, 6) = 1: EM(39, 7) = 1: EM(39, 8) = 2: EM(39, 9) = 1: EM(39, 10) = 2: EM(39, 11) = 1: EM(39, 12) = 2: EM(39, 13) = 354  '1939년

    EM(40, 1) = 2: EM(40, 2) = 2: EM(40, 3) = 1: EM(40, 4) = 2: EM(40, 5) = 1: EM(40, 6) = 2: EM(40, 7) = 1: EM(40, 8) = 1: EM(40, 9) = 2: EM(40, 10) = 1: EM(40, 11) = 2: EM(40, 12) = 1: EM(40, 13) = 354  '1940년

    EM(41, 1) = 2: EM(41, 2) = 2: EM(41, 3) = 1: EM(41, 4) = 2: EM(41, 5) = 2: EM(41, 6) = 4: EM(41, 7) = 1: EM(41, 8) = 1: EM(41, 9) = 2: EM(41, 10) = 1: EM(41, 11) = 2: EM(41, 12) = 1: EM(41, 13) = 384  '1941년

    EM(42, 1) = 2: EM(42, 2) = 1: EM(42, 3) = 2: EM(42, 4) = 2: EM(42, 5) = 1: EM(42, 6) = 2: EM(42, 7) = 2: EM(42, 8) = 1: EM(42, 9) = 2: EM(42, 10) = 1: EM(42, 11) = 1: EM(42, 12) = 2: EM(42, 13) = 355  '1942년

    EM(43, 1) = 1: EM(43, 2) = 2: EM(43, 3) = 1: EM(43, 4) = 2: EM(43, 5) = 1: EM(43, 6) = 2: EM(43, 7) = 2: EM(43, 8) = 1: EM(43, 9) = 2: EM(43, 10) = 2: EM(43, 11) = 1: EM(43, 12) = 2: EM(43, 13) = 355  '1943년

    EM(44, 1) = 1: EM(44, 2) = 1: EM(44, 3) = 2: EM(44, 4) = 4: EM(44, 5) = 1: EM(44, 6) = 2: EM(44, 7) = 1: EM(44, 8) = 2: EM(44, 9) = 2: EM(44, 10) = 1: EM(44, 11) = 2: EM(44, 12) = 2: EM(44, 13) = 384  '1944년

    EM(45, 1) = 1: EM(45, 2) = 1: EM(45, 3) = 2: EM(45, 4) = 1: EM(45, 5) = 1: EM(45, 6) = 2: EM(45, 7) = 1: EM(45, 8) = 2: EM(45, 9) = 2: EM(45, 10) = 2: EM(45, 11) = 1: EM(45, 12) = 2: EM(45, 13) = 354  '1945년

    EM(46, 1) = 2: EM(46, 2) = 1: EM(46, 3) = 1: EM(46, 4) = 2: EM(46, 5) = 1: EM(46, 6) = 1: EM(46, 7) = 2: EM(46, 8) = 1: EM(46, 9) = 2: EM(46, 10) = 2: EM(46, 11) = 1: EM(46, 12) = 2: EM(46, 13) = 354  '1946년

    EM(47, 1) = 2: EM(47, 2) = 5: EM(47, 3) = 1: EM(47, 4) = 2: EM(47, 5) = 1: EM(47, 6) = 1: EM(47, 7) = 2: EM(47, 8) = 1: EM(47, 9) = 2: EM(47, 10) = 1: EM(47, 11) = 2: EM(47, 12) = 2: EM(47, 13) = 384  '1947년

    EM(48, 1) = 2: EM(48, 2) = 1: EM(48, 3) = 2: EM(48, 4) = 1: EM(48, 5) = 2: EM(48, 6) = 1: EM(48, 7) = 1: EM(48, 8) = 2: EM(48, 9) = 1: EM(48, 10) = 2: EM(48, 11) = 1: EM(48, 12) = 2: EM(48, 13) = 354  '1948년

    EM(49, 1) = 2: EM(49, 2) = 2: EM(49, 3) = 1: EM(49, 4) = 2: EM(49, 5) = 1: EM(49, 6) = 2: EM(49, 7) = 3: EM(49, 8) = 2: EM(49, 9) = 1: EM(49, 10) = 2: EM(49, 11) = 1: EM(49, 12) = 2: EM(49, 13) = 384  '1949년

    EM(50, 1) = 2: EM(50, 2) = 1: EM(50, 3) = 2: EM(50, 4) = 2: EM(50, 5) = 1: EM(50, 6) = 2: EM(50, 7) = 1: EM(50, 8) = 1: EM(50, 9) = 2: EM(50, 10) = 1: EM(50, 11) = 2: EM(50, 12) = 1: EM(50, 13) = 354  '1950년

    EM(51, 1) = 2: EM(51, 2) = 1: EM(51, 3) = 2: EM(51, 4) = 2: EM(51, 5) = 1: EM(51, 6) = 2: EM(51, 7) = 1: EM(51, 8) = 2: EM(51, 9) = 1: EM(51, 10) = 2: EM(51, 11) = 1: EM(51, 12) = 2: EM(51, 13) = 355  '1951년

    EM(52, 1) = 1: EM(52, 2) = 2: EM(52, 3) = 1: EM(52, 4) = 2: EM(52, 5) = 4: EM(52, 6) = 2: EM(52, 7) = 1: EM(52, 8) = 2: EM(52, 9) = 1: EM(52, 10) = 2: EM(52, 11) = 1: EM(52, 12) = 2: EM(52, 13) = 384  '1952년

    EM(53, 1) = 1: EM(53, 2) = 2: EM(53, 3) = 1: EM(53, 4) = 1: EM(53, 5) = 2: EM(53, 6) = 2: EM(53, 7) = 1: EM(53, 8) = 2: EM(53, 9) = 2: EM(53, 10) = 1: EM(53, 11) = 2: EM(53, 12) = 2: EM(53, 13) = 355  '1953년

    EM(54, 1) = 1: EM(54, 2) = 1: EM(54, 3) = 2: EM(54, 4) = 1: EM(54, 5) = 1: EM(54, 6) = 2: EM(54, 7) = 1: EM(54, 8) = 2: EM(54, 9) = 2: EM(54, 10) = 1: EM(54, 11) = 2: EM(54, 12) = 2: EM(54, 13) = 354  '1954년

    EM(55, 1) = 2: EM(55, 2) = 1: EM(55, 3) = 4: EM(55, 4) = 1: EM(55, 5) = 1: EM(55, 6) = 2: EM(55, 7) = 1: EM(55, 8) = 2: EM(55, 9) = 1: EM(55, 10) = 2: EM(55, 11) = 2: EM(55, 12) = 2: EM(55, 13) = 384  '1955년

    EM(56, 1) = 1: EM(56, 2) = 2: EM(56, 3) = 1: EM(56, 4) = 2: EM(56, 5) = 1: EM(56, 6) = 1: EM(56, 7) = 2: EM(56, 8) = 1: EM(56, 9) = 2: EM(56, 10) = 1: EM(56, 11) = 2: EM(56, 12) = 2: EM(56, 13) = 354  '1956년

    EM(57, 1) = 2: EM(57, 2) = 1: EM(57, 3) = 2: EM(57, 4) = 1: EM(57, 5) = 2: EM(57, 6) = 1: EM(57, 7) = 1: EM(57, 8) = 5: EM(57, 9) = 2: EM(57, 10) = 1: EM(57, 11) = 2: EM(57, 12) = 2: EM(57, 13) = 384  '1957년

    EM(58, 1) = 1: EM(58, 2) = 2: EM(58, 3) = 2: EM(58, 4) = 1: EM(58, 5) = 2: EM(58, 6) = 1: EM(58, 7) = 1: EM(58, 8) = 2: EM(58, 9) = 1: EM(58, 10) = 2: EM(58, 11) = 1: EM(58, 12) = 2: EM(58, 13) = 354  '1958년

    EM(59, 1) = 1: EM(59, 2) = 2: EM(59, 3) = 2: EM(59, 4) = 1: EM(59, 5) = 2: EM(59, 6) = 1: EM(59, 7) = 2: EM(59, 8) = 1: EM(59, 9) = 2: EM(59, 10) = 1: EM(59, 11) = 2: EM(59, 12) = 1: EM(59, 13) = 354  '1959년

    EM(60, 1) = 2: EM(60, 2) = 1: EM(60, 3) = 2: EM(60, 4) = 1: EM(60, 5) = 2: EM(60, 6) = 5: EM(60, 7) = 2: EM(60, 8) = 1: EM(60, 9) = 2: EM(60, 10) = 1: EM(60, 11) = 2: EM(60, 12) = 1: EM(60, 13) = 384  '1960년

    EM(61, 1) = 2: EM(61, 2) = 1: EM(61, 3) = 2: EM(61, 4) = 1: EM(61, 5) = 2: EM(61, 6) = 1: EM(61, 7) = 2: EM(61, 8) = 2: EM(61, 9) = 1: EM(61, 10) = 2: EM(61, 11) = 1: EM(61, 12) = 2: EM(61, 13) = 355  '1961년

    EM(62, 1) = 1: EM(62, 2) = 2: EM(62, 3) = 1: EM(62, 4) = 1: EM(62, 5) = 2: EM(62, 6) = 1: EM(62, 7) = 2: EM(62, 8) = 2: EM(62, 9) = 1: EM(62, 10) = 2: EM(62, 11) = 2: EM(62, 12) = 1: EM(62, 13) = 354  '1962년

    EM(63, 1) = 2: EM(63, 2) = 1: EM(63, 3) = 2: EM(63, 4) = 3: EM(63, 5) = 2: EM(63, 6) = 1: EM(63, 7) = 2: EM(63, 8) = 1: EM(63, 9) = 2: EM(63, 10) = 2: EM(63, 11) = 2: EM(63, 12) = 1: EM(63, 13) = 384  '1963년

    EM(64, 1) = 2: EM(64, 2) = 1: EM(64, 3) = 2: EM(64, 4) = 1: EM(64, 5) = 1: EM(64, 6) = 2: EM(64, 7) = 1: EM(64, 8) = 2: EM(64, 9) = 1: EM(64, 10) = 2: EM(64, 11) = 2: EM(64, 12) = 2: EM(64, 13) = 355  '1964년

    EM(65, 1) = 1: EM(65, 2) = 2: EM(65, 3) = 1: EM(65, 4) = 2: EM(65, 5) = 1: EM(65, 6) = 1: EM(65, 7) = 2: EM(65, 8) = 1: EM(65, 9) = 1: EM(65, 10) = 2: EM(65, 11) = 2: EM(65, 12) = 1: EM(65, 13) = 353  '1965년

    EM(66, 1) = 2: EM(66, 2) = 2: EM(66, 3) = 5: EM(66, 4) = 2: EM(66, 5) = 1: EM(66, 6) = 1: EM(66, 7) = 2: EM(66, 8) = 1: EM(66, 9) = 1: EM(66, 10) = 2: EM(66, 11) = 2: EM(66, 12) = 1: EM(66, 13) = 384  '1966년

    EM(67, 1) = 2: EM(67, 2) = 2: EM(67, 3) = 1: EM(67, 4) = 2: EM(67, 5) = 2: EM(67, 6) = 1: EM(67, 7) = 1: EM(67, 8) = 2: EM(67, 9) = 1: EM(67, 10) = 2: EM(67, 11) = 1: EM(67, 12) = 2: EM(67, 13) = 355  '1967년

    EM(68, 1) = 1: EM(68, 2) = 2: EM(68, 3) = 2: EM(68, 4) = 1: EM(68, 5) = 2: EM(68, 6) = 1: EM(68, 7) = 5: EM(68, 8) = 2: EM(68, 9) = 1: EM(68, 10) = 2: EM(68, 11) = 1: EM(68, 12) = 2: EM(68, 13) = 384  '1968년

    EM(69, 1) = 1: EM(69, 2) = 2: EM(69, 3) = 1: EM(69, 4) = 2: EM(69, 5) = 1: EM(69, 6) = 2: EM(69, 7) = 2: EM(69, 8) = 1: EM(69, 9) = 2: EM(69, 10) = 1: EM(69, 11) = 2: EM(69, 12) = 1: EM(69, 13) = 354  '1969년

    EM(70, 1) = 2: EM(70, 2) = 1: EM(70, 3) = 1: EM(70, 4) = 2: EM(70, 5) = 2: EM(70, 6) = 1: EM(70, 7) = 2: EM(70, 8) = 1: EM(70, 9) = 2: EM(70, 10) = 2: EM(70, 11) = 1: EM(70, 12) = 2: EM(70, 13) = 355  '1970년

    EM(71, 1) = 1: EM(71, 2) = 2: EM(71, 3) = 1: EM(71, 4) = 1: EM(71, 5) = 5: EM(71, 6) = 2: EM(71, 7) = 1: EM(71, 8) = 2: EM(71, 9) = 2: EM(71, 10) = 2: EM(71, 11) = 1: EM(71, 12) = 2: EM(71, 13) = 384  '1971년

    EM(72, 1) = 1: EM(72, 2) = 2: EM(72, 3) = 1: EM(72, 4) = 1: EM(72, 5) = 2: EM(72, 6) = 1: EM(72, 7) = 2: EM(72, 8) = 1: EM(72, 9) = 2: EM(72, 10) = 2: EM(72, 11) = 2: EM(72, 12) = 1: EM(72, 13) = 354  '1972년

    EM(73, 1) = 2: EM(73, 2) = 1: EM(73, 3) = 2: EM(73, 4) = 1: EM(73, 5) = 1: EM(73, 6) = 2: EM(73, 7) = 1: EM(73, 8) = 1: EM(73, 9) = 2: EM(73, 10) = 2: EM(73, 11) = 2: EM(73, 12) = 1: EM(73, 13) = 354  '1973년

    EM(74, 1) = 2: EM(74, 2) = 2: EM(74, 3) = 1: EM(74, 4) = 5: EM(74, 5) = 1: EM(74, 6) = 2: EM(74, 7) = 1: EM(74, 8) = 1: EM(74, 9) = 2: EM(74, 10) = 2: EM(74, 11) = 1: EM(74, 12) = 2: EM(74, 13) = 384  '1974년

    EM(75, 1) = 2: EM(75, 2) = 2: EM(75, 3) = 1: EM(75, 4) = 2: EM(75, 5) = 1: EM(75, 6) = 1: EM(75, 7) = 2: EM(75, 8) = 1: EM(75, 9) = 1: EM(75, 10) = 2: EM(75, 11) = 1: EM(75, 12) = 2: EM(75, 13) = 354  '1975년

    EM(76, 1) = 2: EM(76, 2) = 2: EM(76, 3) = 1: EM(76, 4) = 2: EM(76, 5) = 1: EM(76, 6) = 2: EM(76, 7) = 1: EM(76, 8) = 5: EM(76, 9) = 2: EM(76, 10) = 1: EM(76, 11) = 1: EM(76, 12) = 2: EM(76, 13) = 384  '1976년

    EM(77, 1) = 2: EM(77, 2) = 1: EM(77, 3) = 2: EM(77, 4) = 2: EM(77, 5) = 1: EM(77, 6) = 2: EM(77, 7) = 1: EM(77, 8) = 2: EM(77, 9) = 1: EM(77, 10) = 2: EM(77, 11) = 1: EM(77, 12) = 1: EM(77, 13) = 354  '1977년

    EM(78, 1) = 2: EM(78, 2) = 2: EM(78, 3) = 1: EM(78, 4) = 2: EM(78, 5) = 1: EM(78, 6) = 2: EM(78, 7) = 2: EM(78, 8) = 1: EM(78, 9) = 2: EM(78, 10) = 1: EM(78, 11) = 2: EM(78, 12) = 1: EM(78, 13) = 355  '1978년

    EM(79, 1) = 2: EM(79, 2) = 1: EM(79, 3) = 1: EM(79, 4) = 2: EM(79, 5) = 1: EM(79, 6) = 6: EM(79, 7) = 1: EM(79, 8) = 2: EM(79, 9) = 2: EM(79, 10) = 1: EM(79, 11) = 2: EM(79, 12) = 1: EM(79, 13) = 384  '1979년

    EM(80, 1) = 2: EM(80, 2) = 1: EM(80, 3) = 1: EM(80, 4) = 2: EM(80, 5) = 1: EM(80, 6) = 2: EM(80, 7) = 1: EM(80, 8) = 2: EM(80, 9) = 2: EM(80, 10) = 1: EM(80, 11) = 2: EM(80, 12) = 2: EM(80, 13) = 355  '1980년

    EM(81, 1) = 1: EM(81, 2) = 2: EM(81, 3) = 1: EM(81, 4) = 1: EM(81, 5) = 2: EM(81, 6) = 1: EM(81, 7) = 1: EM(81, 8) = 2: EM(81, 9) = 2: EM(81, 10) = 1: EM(81, 11) = 2: EM(81, 12) = 2: EM(81, 13) = 354  '1981년

    EM(82, 1) = 2: EM(82, 2) = 1: EM(82, 3) = 2: EM(82, 4) = 3: EM(82, 5) = 2: EM(82, 6) = 1: EM(82, 7) = 1: EM(82, 8) = 2: EM(82, 9) = 2: EM(82, 10) = 1: EM(82, 11) = 2: EM(82, 12) = 2: EM(82, 13) = 384  '1982년

    EM(83, 1) = 2: EM(83, 2) = 1: EM(83, 3) = 2: EM(83, 4) = 1: EM(83, 5) = 1: EM(83, 6) = 2: EM(83, 7) = 1: EM(83, 8) = 1: EM(83, 9) = 2: EM(83, 10) = 1: EM(83, 11) = 2: EM(83, 12) = 2: EM(83, 13) = 354  '1983년

    EM(84, 1) = 2: EM(84, 2) = 1: EM(84, 3) = 2: EM(84, 4) = 2: EM(84, 5) = 1: EM(84, 6) = 1: EM(84, 7) = 2: EM(84, 8) = 1: EM(84, 9) = 1: EM(84, 10) = 5: EM(84, 11) = 2: EM(84, 12) = 2: EM(84, 13) = 384  '1984년

    EM(85, 1) = 1: EM(85, 2) = 2: EM(85, 3) = 2: EM(85, 4) = 1: EM(85, 5) = 2: EM(85, 6) = 1: EM(85, 7) = 2: EM(85, 8) = 1: EM(85, 9) = 1: EM(85, 10) = 2: EM(85, 11) = 1: EM(85, 12) = 2: EM(85, 13) = 354  '1985년

    EM(86, 1) = 1: EM(86, 2) = 2: EM(86, 3) = 2: EM(86, 4) = 1: EM(86, 5) = 2: EM(86, 6) = 2: EM(86, 7) = 1: EM(86, 8) = 2: EM(86, 9) = 1: EM(86, 10) = 2: EM(86, 11) = 1: EM(86, 12) = 1: EM(86, 13) = 354  '1986년

    EM(87, 1) = 2: EM(87, 2) = 1: EM(87, 3) = 2: EM(87, 4) = 2: EM(87, 5) = 1: EM(87, 6) = 5: EM(87, 7) = 2: EM(87, 8) = 2: EM(87, 9) = 1: EM(87, 10) = 2: EM(87, 11) = 1: EM(87, 12) = 2: EM(87, 13) = 385  '1987년

    EM(88, 1) = 1: EM(88, 2) = 1: EM(88, 3) = 2: EM(88, 4) = 1: EM(88, 5) = 2: EM(88, 6) = 1: EM(88, 7) = 2: EM(88, 8) = 2: EM(88, 9) = 1: EM(88, 10) = 2: EM(88, 11) = 2: EM(88, 12) = 1: EM(88, 13) = 354  '1988년

    EM(89, 1) = 2: EM(89, 2) = 1: EM(89, 3) = 1: EM(89, 4) = 2: EM(89, 5) = 1: EM(89, 6) = 2: EM(89, 7) = 1: EM(89, 8) = 2: EM(89, 9) = 2: EM(89, 10) = 1: EM(89, 11) = 2: EM(89, 12) = 2: EM(89, 13) = 355  '1989년

    EM(90, 1) = 1: EM(90, 2) = 2: EM(90, 3) = 1: EM(90, 4) = 1: EM(90, 5) = 5: EM(90, 6) = 1: EM(90, 7) = 2: EM(90, 8) = 1: EM(90, 9) = 2: EM(90, 10) = 2: EM(90, 11) = 2: EM(90, 12) = 2: EM(90, 13) = 384  '1990년

    EM(91, 1) = 1: EM(91, 2) = 2: EM(91, 3) = 1: EM(91, 4) = 1: EM(91, 5) = 2: EM(91, 6) = 1: EM(91, 7) = 1: EM(91, 8) = 2: EM(91, 9) = 1: EM(91, 10) = 2: EM(91, 11) = 2: EM(91, 12) = 2: EM(91, 13) = 354  '1991년

    EM(92, 1) = 1: EM(92, 2) = 2: EM(92, 3) = 2: EM(92, 4) = 1: EM(92, 5) = 1: EM(92, 6) = 2: EM(92, 7) = 1: EM(92, 8) = 1: EM(92, 9) = 2: EM(92, 10) = 1: EM(92, 11) = 2: EM(92, 12) = 2: EM(92, 13) = 354  '1992년

    EM(93, 1) = 1: EM(93, 2) = 2: EM(93, 3) = 5: EM(93, 4) = 2: EM(93, 5) = 1: EM(93, 6) = 2: EM(93, 7) = 1: EM(93, 8) = 1: EM(93, 9) = 2: EM(93, 10) = 1: EM(93, 11) = 2: EM(93, 12) = 1: EM(93, 13) = 383  '1993년

    EM(94, 1) = 2: EM(94, 2) = 2: EM(94, 3) = 2: EM(94, 4) = 1: EM(94, 5) = 2: EM(94, 6) = 1: EM(94, 7) = 2: EM(94, 8) = 1: EM(94, 9) = 1: EM(94, 10) = 2: EM(94, 11) = 1: EM(94, 12) = 2: EM(94, 13) = 355  '1994년

    EM(95, 1) = 1: EM(95, 2) = 2: EM(95, 3) = 2: EM(95, 4) = 1: EM(95, 5) = 2: EM(95, 6) = 2: EM(95, 7) = 1: EM(95, 8) = 5: EM(95, 9) = 2: EM(95, 10) = 1: EM(95, 11) = 1: EM(95, 12) = 2: EM(95, 13) = 384  '1995년

    EM(96, 1) = 1: EM(96, 2) = 2: EM(96, 3) = 1: EM(96, 4) = 2: EM(96, 5) = 2: EM(96, 6) = 1: EM(96, 7) = 2: EM(96, 8) = 1: EM(96, 9) = 2: EM(96, 10) = 2: EM(96, 11) = 1: EM(96, 12) = 2: EM(96, 13) = 355  '1996년

    EM(97, 1) = 1: EM(97, 2) = 1: EM(97, 3) = 2: EM(97, 4) = 1: EM(97, 5) = 2: EM(97, 6) = 1: EM(97, 7) = 2: EM(97, 8) = 2: EM(97, 9) = 1: EM(97, 10) = 2: EM(97, 11) = 2: EM(97, 12) = 1: EM(97, 13) = 354  '1997년

    EM(98, 1) = 2: EM(98, 2) = 1: EM(98, 3) = 1: EM(98, 4) = 2: EM(98, 5) = 3: EM(98, 6) = 2: EM(98, 7) = 2: EM(98, 8) = 1: EM(98, 9) = 2: EM(98, 10) = 2: EM(98, 11) = 2: EM(98, 12) = 1: EM(98, 13) = 384  '1998년

    EM(99, 1) = 2: EM(99, 2) = 1: EM(99, 3) = 1: EM(99, 4) = 2: EM(99, 5) = 1: EM(99, 6) = 1: EM(99, 7) = 2: EM(99, 8) = 1: EM(99, 9) = 2: EM(99, 10) = 2: EM(99, 11) = 2: EM(99, 12) = 1: EM(99, 13) = 354  '1999년

    EM(100, 1) = 2: EM(100, 2) = 2: EM(100, 3) = 1: EM(100, 4) = 1: EM(100, 5) = 2: EM(100, 6) = 1: EM(100, 7) = 1: EM(100, 8) = 2: EM(100, 9) = 1: EM(100, 10) = 2: EM(100, 11) = 2: EM(100, 12) = 1: EM(100, 13) = 354 '2000년

    EM(101, 1) = 2: EM(101, 2) = 2: EM(101, 3) = 2: EM(101, 4) = 3: EM(101, 5) = 2: EM(101, 6) = 1: EM(101, 7) = 1: EM(101, 8) = 2: EM(101, 9) = 1: EM(101, 10) = 2: EM(101, 11) = 1: EM(101, 12) = 2: EM(101, 13) = 384 '2001년

    EM(102, 1) = 2: EM(102, 2) = 2: EM(102, 3) = 1: EM(102, 4) = 2: EM(102, 5) = 1: EM(102, 6) = 2: EM(102, 7) = 1: EM(102, 8) = 1: EM(102, 9) = 2: EM(102, 10) = 1: EM(102, 11) = 2: EM(102, 12) = 1: EM(102, 13) = 354 '2002년

    EM(103, 1) = 2: EM(103, 2) = 2: EM(103, 3) = 1: EM(103, 4) = 2: EM(103, 5) = 2: EM(103, 6) = 1: EM(103, 7) = 2: EM(103, 8) = 1: EM(103, 9) = 1: EM(103, 10) = 2: EM(103, 11) = 1: EM(103, 12) = 2: EM(103, 13) = 355 '2003년

    EM(104, 1) = 1: EM(104, 2) = 5: EM(104, 3) = 2: EM(104, 4) = 2: EM(104, 5) = 1: EM(104, 6) = 2: EM(104, 7) = 1: EM(104, 8) = 2: EM(104, 9) = 2: EM(104, 10) = 1: EM(104, 11) = 1: EM(104, 12) = 2: EM(104, 13) = 384 '2004년

    EM(105, 1) = 1: EM(105, 2) = 2: EM(105, 3) = 1: EM(105, 4) = 2: EM(105, 5) = 1: EM(105, 6) = 2: EM(105, 7) = 2: EM(105, 8) = 1: EM(105, 9) = 2: EM(105, 10) = 2: EM(105, 11) = 1: EM(105, 12) = 2: EM(105, 13) = 355 '2005년

    EM(106, 1) = 1: EM(106, 2) = 1: EM(106, 3) = 2: EM(106, 4) = 1: EM(106, 5) = 2: EM(106, 6) = 1: EM(106, 7) = 5: EM(106, 8) = 2: EM(106, 9) = 2: EM(106, 10) = 1: EM(106, 11) = 2: EM(106, 12) = 2: EM(106, 13) = 384 '2006년

    EM(107, 1) = 1: EM(107, 2) = 1: EM(107, 3) = 2: EM(107, 4) = 1: EM(107, 5) = 1: EM(107, 6) = 2: EM(107, 7) = 1: EM(107, 8) = 2: EM(107, 9) = 2: EM(107, 10) = 2: EM(107, 11) = 1: EM(107, 12) = 2: EM(107, 13) = 354 '2007년

    EM(108, 1) = 2: EM(108, 2) = 1: EM(108, 3) = 1: EM(108, 4) = 2: EM(108, 5) = 1: EM(108, 6) = 1: EM(108, 7) = 2: EM(108, 8) = 1: EM(108, 9) = 2: EM(108, 10) = 2: EM(108, 11) = 1: EM(108, 12) = 2: EM(108, 13) = 354 '2008년

    EM(109, 1) = 2: EM(109, 2) = 2: EM(109, 3) = 1: EM(109, 4) = 1: EM(109, 5) = 5: EM(109, 6) = 1: EM(109, 7) = 2: EM(109, 8) = 1: EM(109, 9) = 2: EM(109, 10) = 1: EM(109, 11) = 2: EM(109, 12) = 2: EM(109, 13) = 384 '2009년

    EM(110, 1) = 2: EM(110, 2) = 1: EM(110, 3) = 2: EM(110, 4) = 1: EM(110, 5) = 2: EM(110, 6) = 1: EM(110, 7) = 1: EM(110, 8) = 2: EM(110, 9) = 1: EM(110, 10) = 2: EM(110, 11) = 1: EM(110, 12) = 2: EM(110, 13) = 354  '2010년

    EM(111, 1) = 2: EM(111, 2) = 1: EM(111, 3) = 2: EM(111, 4) = 2: EM(111, 5) = 1: EM(111, 6) = 2: EM(111, 7) = 1: EM(111, 8) = 1: EM(111, 9) = 2: EM(111, 10) = 1: EM(111, 11) = 2: EM(111, 12) = 1: EM(111, 13) = 354  '2011년

    EM(112, 1) = 2: EM(112, 2) = 1: EM(112, 3) = 6: EM(112, 4) = 2: EM(112, 5) = 1: EM(112, 6) = 2: EM(112, 7) = 1: EM(112, 8) = 1: EM(112, 9) = 2: EM(112, 10) = 1: EM(112, 11) = 2: EM(112, 12) = 1: EM(112, 13) = 384  '2012년

    EM(113, 1) = 2: EM(113, 2) = 1: EM(113, 3) = 2: EM(113, 4) = 2: EM(113, 5) = 1: EM(113, 6) = 2: EM(113, 7) = 1: EM(113, 8) = 2: EM(113, 9) = 1: EM(113, 10) = 2: EM(113, 11) = 1: EM(113, 12) = 2: EM(113, 13) = 355  '2013년

    EM(114, 1) = 1: EM(114, 2) = 2: EM(114, 3) = 1: EM(114, 4) = 2: EM(114, 5) = 1: EM(114, 6) = 2: EM(114, 7) = 1: EM(114, 8) = 2: EM(114, 9) = 5: EM(114, 10) = 2: EM(114, 11) = 1: EM(114, 12) = 2: EM(114, 13) = 384  '2014년

    EM(115, 1) = 1: EM(115, 2) = 2: EM(115, 3) = 1: EM(115, 4) = 1: EM(115, 5) = 2: EM(115, 6) = 1: EM(115, 7) = 2: EM(115, 8) = 2: EM(115, 9) = 2: EM(115, 10) = 1: EM(115, 11) = 2: EM(115, 12) = 2: EM(115, 13) = 355  '2015년

    EM(116, 1) = 1: EM(116, 2) = 1: EM(116, 3) = 2: EM(116, 4) = 1: EM(116, 5) = 1: EM(116, 6) = 2: EM(116, 7) = 1: EM(116, 8) = 2: EM(116, 9) = 2: EM(116, 10) = 1: EM(116, 11) = 2: EM(116, 12) = 2: EM(116, 13) = 354  '2016년

    EM(117, 1) = 2: EM(117, 2) = 1: EM(117, 3) = 1: EM(117, 4) = 2: EM(117, 5) = 3: EM(117, 6) = 2: EM(117, 7) = 1: EM(117, 8) = 2: EM(117, 9) = 1: EM(117, 10) = 2: EM(117, 11) = 2: EM(117, 12) = 2: EM(117, 13) = 384  '2017년

    EM(118, 1) = 1: EM(118, 2) = 2: EM(118, 3) = 1: EM(118, 4) = 2: EM(118, 5) = 1: EM(118, 6) = 1: EM(118, 7) = 2: EM(118, 8) = 1: EM(118, 9) = 2: EM(118, 10) = 1: EM(118, 11) = 2: EM(118, 12) = 2: EM(118, 13) = 354  '2018년

    EM(119, 1) = 2: EM(119, 2) = 1: EM(119, 3) = 2: EM(119, 4) = 1: EM(119, 5) = 2: EM(119, 6) = 1: EM(119, 7) = 1: EM(119, 8) = 2: EM(119, 9) = 1: EM(119, 10) = 2: EM(119, 11) = 1: EM(119, 12) = 2: EM(119, 13) = 354  '2019년

    EM(120, 1) = 2: EM(120, 2) = 1: EM(120, 3) = 2: EM(120, 4) = 5: EM(120, 5) = 2: EM(120, 6) = 1: EM(120, 7) = 1: EM(120, 8) = 2: EM(120, 9) = 1: EM(120, 10) = 2: EM(120, 11) = 1: EM(120, 12) = 2: EM(120, 13) = 384  '2020년

    EM(121, 1) = 1: EM(121, 2) = 2: EM(121, 3) = 2: EM(121, 4) = 1: EM(121, 5) = 2: EM(121, 6) = 1: EM(121, 7) = 2: EM(121, 8) = 1: EM(121, 9) = 2: EM(121, 10) = 1: EM(121, 11) = 2: EM(121, 12) = 1: EM(121, 13) = 354  '2021년

    EM(122, 1) = 2: EM(122, 2) = 1: EM(122, 3) = 2: EM(122, 4) = 1: EM(122, 5) = 2: EM(122, 6) = 2: EM(122, 7) = 1: EM(122, 8) = 2: EM(122, 9) = 1: EM(122, 10) = 2: EM(122, 11) = 1: EM(122, 12) = 2: EM(122, 13) = 355  '2022년

    EM(123, 1) = 1: EM(123, 2) = 5: EM(123, 3) = 2: EM(123, 4) = 1: EM(123, 5) = 2: EM(123, 6) = 1: EM(123, 7) = 2: EM(123, 8) = 2: EM(123, 9) = 1: EM(123, 10) = 2: EM(123, 11) = 1: EM(123, 12) = 2: EM(123, 13) = 384  '2023년

    EM(124, 1) = 1: EM(124, 2) = 2: EM(124, 3) = 1: EM(124, 4) = 1: EM(124, 5) = 2: EM(124, 6) = 1: EM(124, 7) = 2: EM(124, 8) = 2: EM(124, 9) = 1: EM(124, 10) = 2: EM(124, 11) = 2: EM(124, 12) = 1: EM(124, 13) = 354  '2024년

    EM(125, 1) = 2: EM(125, 2) = 1: EM(125, 3) = 2: EM(125, 4) = 1: EM(125, 5) = 1: EM(125, 6) = 5: EM(125, 7) = 2: EM(125, 8) = 1: EM(125, 9) = 2: EM(125, 10) = 2: EM(125, 11) = 2: EM(125, 12) = 1: EM(125, 13) = 384  '2025년

    EM(126, 1) = 2: EM(126, 2) = 1: EM(126, 3) = 2: EM(126, 4) = 1: EM(126, 5) = 1: EM(126, 6) = 2: EM(126, 7) = 1: EM(126, 8) = 2: EM(126, 9) = 1: EM(126, 10) = 2: EM(126, 11) = 2: EM(126, 12) = 2: EM(126, 13) = 355  '2026년

    EM(127, 1) = 1: EM(127, 2) = 2: EM(127, 3) = 1: EM(127, 4) = 2: EM(127, 5) = 1: EM(127, 6) = 1: EM(127, 7) = 2: EM(127, 8) = 1: EM(127, 9) = 1: EM(127, 10) = 2: EM(127, 11) = 2: EM(127, 12) = 2: EM(127, 13) = 354  '2027년

    EM(128, 1) = 1: EM(128, 2) = 2: EM(128, 3) = 2: EM(128, 4) = 1: EM(128, 5) = 5: EM(128, 6) = 1: EM(128, 7) = 2: EM(128, 8) = 1: EM(128, 9) = 1: EM(128, 10) = 2: EM(128, 11) = 2: EM(128, 12) = 1: EM(128, 13) = 383  '2028년

    EM(129, 1) = 2: EM(129, 2) = 2: EM(129, 3) = 1: EM(129, 4) = 2: EM(129, 5) = 2: EM(129, 6) = 1: EM(129, 7) = 1: EM(129, 8) = 2: EM(129, 9) = 1: EM(129, 10) = 1: EM(129, 11) = 2: EM(129, 12) = 2: EM(129, 13) = 355  '2029년

    EM(130, 1) = 1: EM(130, 2) = 2: EM(130, 3) = 1: EM(130, 4) = 2: EM(130, 5) = 2: EM(130, 6) = 1: EM(130, 7) = 2: EM(130, 8) = 1: EM(130, 9) = 2: EM(130, 10) = 1: EM(130, 11) = 2: EM(130, 12) = 1: EM(130, 13) = 354  '2030년

End Sub

Function LunToSun(LY As Integer, LM As Integer, LD As Integer, LA As Boolean) As Date

    On Error GoTo ErrorLun

    Dim Y As Integer

    Dim T As Long, Y1 As Long, Y2 As Long, i As Integer, SY As Single, SM, SD, SW As Integer

    Y = LY - 1900

    Call CalenderData

    T = LD + 49   ' 기준해인 1901년은 음력 1월 1일이 양력보다 49일 늦다

    For i = 1 To Y - 1   ' 전해까지의 음력일수를 구한다

        T = T + EM(i, 13)

    Next i

    For i = 1 To LM - 1    '전월까지의 음력일수를 계산한다

        T = T + VM(EM(Y, i))

    Next i

    If LA = True And EM(Y, LM) < 3 Then   '윤달이 맞는지 확인한다

       MsgBox "이 달은 윤달이 아닙니다."

       CY = 0: CM = 0: CD = 0

       Exit Function

    End If

    If LA = True Then     '윤달인 경우 윤달 일수를 계산한다

       If EM(Y, LM) = 3 Or EM(Y, LM) = 4 Then

          T = T + 29

       Else

          T = T + 30

       End If

    End If

    ' 양력이 4년에 한번씩 윤년이 있으므로 계산할 음력해까지

    ' 몇번의 윤년이 있는가 알기위해 음력의 누적일수를 양력 4년 동안의 일수로 나눈 몫을 구한다.

    LunToSun = CDate(T + 366)

    Exit Function

ErrorLun:

    Exit Function

End Function

Function SunToLun(SY As Integer, SM As Long, SD As Long)

    On Error GoTo ErrorSun

    '양력날짜를 음력날짜로 바꾼다

    Dim T As Long

    Dim LY As Single

    Dim LM As Integer

    Dim LD As Integer

    Dim Y As Long

    Y = SY - 1900

    Call CalenderData  '음력 데이타를 불러온다

    '양력날짜를 합산한다

    T = 365 * (Y - 1) + MT(SM - 1) + SD + Int(Y / 4)

    If Y = 4 * Int(Y / 4) And 30 * SM + SD < 90 Then

       T = T - 1

    End If

    T = T - 49 '2001년은 음력이 양력보다 49일 늦으므로 1월 1일을 맞추기 위래 49를 뺀다

    LY = 1

    '음력해를 찾는다

    Do While (T > EM(LY, 13))

       T = T - EM(LY, 13)

       LY = LY + 1

    Loop

    '음력월을 찾는다

    LM = 1

    Do While (T > VM(EM(LY, LM)))

       T = T - VM(EM(LY, LM))

       LM = LM + 1

    Loop

    LD = T

    CY = LY + 1900: CM = LM: CD = LD

    '윤달인지 검사

    If (EM(LY, LM) = 3 Or EM(LY, LM) = 4) And T > 29 Then

       CD = T - 29: CA = True

    ElseIf (EM(LY, LM) = 5 Or EM(LY, LM) = 6) And T > 30 Then

       CD = T - 30: CA = True

    Else: CA = False

    End If

    If CA = True Then       '윤달인경우 윤달을 표시하기 위한 조건문

        SunToLun = CY & "-" & "윤" & CM & "-" & CD

        Else

        SunToLun = CY & "-" & CM & "-" & CD

        End If

    Exit Function

ErrorSun:

    Exit Function

End Function

주소에서 중복부분만 제거하고 싶을 때

문의사항

"경기 광명시 소하동(소하동) 365번지" 이런식인 주소를

"경기 광명시 소하동 365번지" 로 바꾸고 싶어요.

"경기 광명시 소하1동(소하동)" 이렇게 앞뒤가 다른 말은 그대로 두고요.

주소처리하는 작업도 알아두면 좋을 거 같아서 작성을 해봤습니다.

수정해서 사용하실 분은 빨간색 글씨만 수정해서 사용하면 됩니다.

Sub juso_check()
    Dim rngC As Range
    Dim rngDB As Range
    Dim startT As Byte '// (시작위치 변수 지정
    Dim endT As Byte   '// ( 마지막 위치 지정
    Dim tempV, tempC As String
   
   Application.ScreenUpdating = False        '//화면 업데이트 (일시) 정지
    Set rngDB = Range([A2], Cells(Rows.Count, "A").End(3))
    '// 주소가 들어간 범위의 열의 마지막 데이터까지 자동 인식
    For Each rngC In rngDB
        startT = InStr(rngC, "(")
        endT = InStr(rngC, ")")
        tempV = Mid(rngC, startT + 1, endT - startT - 1) '// 괄호안의 글자
        tempC = Mid(rngC, startT - Len(tempV), Len(tempV))  '//괄호안의 글자길이만큼의 앞의 글자
        If tempV = tempC Then
            rngC.Offset(0,1) = Left(rngC, startT - 1) & Mid(rngC, endT + 1, Len(rngC) - endT)
            '// rngC.Offset(0,1) 은 오른쪽으로 1열 이동하라는 의미
            '// 만약 값을 5열 정도 뒤로 이동하고자 한다면 rngC.Offset(0,5) 로 변경하세요
        Else
            rngC.Offset(0, 1) = rngC
        End If
    Next rngC
    Set rngDB = Nothing    '// 개체변수 초기화
    Columns("B").AutoFit  '// 주소를 추출한 열 자동 맞춤
    MsgBox "작업완료"
End Sub

고급필터 AdvancedFilter

고급필터로 조건 찾는 것은 이거 하나면 복사하는 건 제대로 해결할 수 있도록 만들었습니다.

범위값만 변경하고 조건만 지정하면 원하는 결과가 바로 찾아집니다.

고급필터.vbs

위의 VBA코드를 적용하면 원하는 결과를 뽑아낼 수가 있습니다.

파일 다운로드 받아서 엑셀화면에서 Alt + F11 누르면 팝업되는 창의 메뉴에서 [삽입]- [모듈] 선택하여

이코드를 붙여넣기 하고 붉은색으로 표시된 부분을 수정하면 됩니다.

Range("A5").CurrentRegion.Clear 이 부분이 AutoFilter를 적용할 때와 다른 점은

Range("A5").CurrentRegion.Offset(1).Clear  제목행 아래 데이터만 전부 삭제하라고 하는데

고급필터에서는 제목행까지 모두 지워줘야 제대로 동작합니다.

데이터가 있는 시트와 결과를 표출할 시트까지 직접 지정하도록 한 것은 다른 시트에 있을때도 이상없이 동작되도록 하기 위함입니다.

검색할 조건영역은

제목과 필터를 걸 조건을 다중으로 선택할 수 있습니다.

검색조건은 반드시 위 그림처럼 두행으로 표시해서 조건이 많으면 열을 늘려줘야 합니다.

AverageIF 함수를 사용하여 과목별 평균값 구하는 VBA

지식인에 올라온 문의사항을 AverageIF함수를 활용하여 평균을 구하는 VBA Code 입니다.

Option Explicit
Sub 과목별평균()
    Dim rngC As Range           '// Data 시트 각 셀을 넣을 변수
    Dim rngData As Range        '// Data 시트 전체 영역 변수
    Dim avgData As Range      '// Data 시트 평균을 낼 영역 변수
    Dim rngT As Range           '// 결과 시트 변수
    Dim rngVariable As Range    '// 결과 산출 변수
    Dim i, j As Integer
    Dim oldTime As Single       '// 걸린 시간 구하는 변수 지정
   
    oldTime = Timer     '// 시간 변수 설정

    Application.ScreenUpdating = False        '// 화면 업데이트 (일시) 정지
    Set rngData = Range(Sheets("과목별").[A2], Sheets("과목별").Cells(Rows.Count, "A").End(3))
    Set avgData = Range(Sheets("과목별").[B2], Sheets("과목별").Cells(Rows.Count, "B").End(3))
    Set rngT = Sheets("평균").[A2]
    rngT.CurrentRegion.Offset(1).Clear  '//기존 데이터 값 초기화
   
    For Each rngC In rngData
        Set rngVariable = Range(rngT, rngT.End(4))
        '// COUNTIF(범위,조건) : 범위에서 조건에 맞는게 몇개인지 카운트하라
        '// Averageif(조건범위, 조건, 평균범위)
        If Application.CountIf(rngVariable, rngC) = 0 Then
            rngT.Offset(i) = rngC
            rngT.Offset(i, 1) = Application.AverageIf(rngData, rngC, avgData)
            i = i + 1
        End If
    Next rngC
   
    With Sheets("평균")   '// 결과를 표시할 Sheet 선택
        '--------------- 가운데 정렬, 선그리기 ----------------------------
        .Range("A1").CurrentRegion.HorizontalAlignment = xlCenter
        .Range(.[B2], .Cells(Rows.Count, "B").End(3)).NumberFormat = "#,###" '// 셀서식 : 3단위 콤마
        .UsedRange.Borders.LineStyle = 1     '// 현재시트 사용영역 선그리기
        .Range("A2").CurrentRegion.Sort key1:=Range("B2"), order1:=xlDescending
    End With
      
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

AverageIF_VBA.vbs

과목별평균.xlsm

특정 전화번호(010으로 시작하는 번호)만 추출하기

Sub cellphone_search()
    Dim rngC As Range
    Dim rngAll As Range
    Dim i As Integer
   
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    Set rngAll = Range([A1], Cells(Rows.Count, "C").End(3))
    '// 범위 지정하는 거니까 셀을 보고 수정하세요.
    '// A1 셀부터 C열의 마지막 셀까지 지정한 것이므로 어디 수정해야 하는지 알겠죠?
    Sheets("Sheet2").Range("A1").CurrentRegion.Offset(1).Clear
    '// 복사할 대상의 시트명을 지정한 것이므로 다른 시트라면 이걸 수정하세요.
    For Each rngC In rngAll
        If Left(rngC.Value, 3) = "010" Then
            rngC.Copy Sheets("Sheet2").Cells(Rows.Count, "A").End(3)(2)
            '//  Sheets("Sheet2") 의 A열의 마지막셀 다음에 계속해서 추가하라는 의미
            i = i + 1
        End If
    Next rngC
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & i & "건 복사"
End Sub

만약 다른 시트에서도 가능하게 하고 싶다면
Set rngAll = Range([A1], Cells(Rows.Count, "C").End(3))
이것을
Set rngAll = Range(Sheets("Sheet1").[A1], Sheets("Sheet1").Cells(Rows.Count, "C").End(3))
이렇게 시트명까지 지정하는 걸 추가하면 됩니다.

[VBA] 최대값 셀에 배경색 지정

각 줄에서 가장 큰 값에 노랑색으로 채우고 싶을 때 어떻게 하죠?

관련 VBA 코드입니다.

Max_BackColor.vbs

Option Explicit
Sub Max_BackColor()
    Dim r As Long     '// 각 행을 늘려갈 변수
    Dim rowsCnt As Long   '// 전체 행의 개수를 넣을 변수
    Dim MaxNum As Long  '// 열의 최대값 변수
    Dim rngC As Range       '// 열 변동 변수
    Dim rngC_All As Range  '// 열 범위 변수
   
    Application.ScreenUpdating = False
    '// 셀에 배경색이 지정되어 있는 걸 초기화
    With Range([B2], Cells(Rows.Count, "D").End(3)).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    rowsCnt = Cells(Rows.Count, "A").End(3).Row
    For r = 2 To rowsCnt   '// 2행부터 마지막행까지 1씩 늘려나감
        Set rngC_All = Range(Cells(r, "B"), Cells(r, "D"))  '// 각행의 열범위 지정
        MaxNum = Application.Max(rngC_All)  '// 해당 행의 최대값
        For Each rngC In rngC_All
            If rngC = MaxNum Then
                rngC.Interior.ColorIndex = 6    '// 6 은 노란색
                Exit For
            End If
        Next rngC
    Next r
End Sub

찾는 내용이 포함된 셀의 행 가져오기 VBA

찾는 셀의 내용이 입력한 텍스트와 100% 일치하는 경우는 앞 게시물에서 다뤘구요.

지금 다루는 사항은 입력한 텍스트가 포함된 셀이 있는 경우만 찾아서 복사하라는 VBA 코드입니다.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngAll As Range
    Dim rngC As Range
    Dim Taget As String
   
    If Target.Address <> "$A$2" Or IsEmpty(Target) Then Exit Sub
    Application.ScreenUpdating = False      '// 화면 업데이트 중지
    Sheets("Sheet2").Range("A5").CurrentRegion.Offset(1).Clear   '// 기존 데이터를 전부 삭제
    Set rngAll = Sheets("data").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
    Set rngC = rngAll.Columns(3) '// 전체범위에서 선택할 열 3은 C열
    Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1) '// A2 행부터 범위 재지정

    With Sheets("Sheet2")  '// 해당 시트명 직접 입력, ActiveSheet 로 하면 됨

        If WorksheetFunction.CountIf(rngC, "*" & Target & "*") = 0 Then
            MsgBox " 찾는 자료가 없습니다! ", 64, "입력오류 "
            Exit Sub
        Else
            rngC.AutoFilter Field:=1, Criteria1:="*" & Target & "*", VisibleDropDown:=False
            '// Target 포함된 행만 선별
            rngAll.Copy .Cells(Rows.Count, "A").End(3)(2)
            '// 자동 필터된 값을 시트의 마지막 아래행에 복사하라
        End If
    End With
    rngC.AutoFilter  '// 자동필터 해제
    Columns.AutoFit  '// 열너비 자동 맞춤

    Set rngAll = Nothing  '// 변수 초기화
End Sub

의미파악 :

어떤 Sheet 인지를 직접 다 적어주면 다른 Sheet 에서 결과를 실행해도 원하는 결과를 찾을 수 있습니다.

굵은 글씨나 색상이 다르게 표시된 부분을 눈여겨 보면 됩니다.

Columns(3) 은 3번째 열에서 찾을 내용이 있을 경우이므로, 만약 다른 열에 있다면 이 부분 숫자를 변경하면 됩니다.

가져가서 수정해서 쓴다면 파란색 부분만 상황에 맞게 수정하면 나머지는 수정하지 않아도 동작할 것입니다.

Fetch of Finding Cell.vbs

계속 배우는 중이라 생각한대로 동작이 안되거나 확인이 필요하면 F8키를 눌러가면서 일일이 어떤 동작의 변화가 발생하는지 체크를 하면서 정리중입니다.

위의 코드는 F8키를 눌러가면서 하면 에러가 발생합니다.

아래처럼 A2 셀에 입력한 값을 지정하고 F8키를 눌러가면서 실행을 합니다.

무조건 복사하여 이용하는 것보다 어떻게 변화하고 움직이는지 도움이 되기 때문에 상황에 맞게 응용하여 사용할 수가 있게 됩니다.

Sub AutoFilter_Copy()

    Dim rngAll As Range
    Dim rngC As Range
    Dim Taget As String

    Dim fstRow As Range   '// 첫줄 복사하기 위한 범위 지정 변수

    Target = Sheets("Sheet2").Cells(2, 1).Value      '// 조건 검색어

    If IsEmpty(Target) Then Exit Sub

    Application.ScreenUpdating = False      '// 화면 업데이트 중지

    Set fstRow = Sheets("data").Range("A1")  '// 복사할 범위의 첫셀 지정

    Range(fstRow, fstRow.End(2)).Copy Sheets("Sheet2").Range("A5")  '// 첫줄을 복사하여 Sheet2의 A5에 복사

    Sheets("Sheet2").Range("A5").CurrentRegion.Offset(1).Clear   '// 기존 데이터를 전부 삭제
    Set rngAll = Sheets("data").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
    Set rngC = rngAll.Columns(3) '// 전체범위에서 선택할 열 3은 C열
    Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1) '// A2 행부터 범위 재지정

    With Sheets("Sheet2")  '// 해당 시트명 직접 입력, ActiveSheet 로 하면 됨

        If WorksheetFunction.CountIf(rngC, "*" & Target & "*") = 0 Then
            MsgBox " 찾는 자료가 없습니다! ", 64, "입력오류 "
            Exit Sub
        Else
            rngC.AutoFilter Field:=1, Criteria1:="*" & Target & "*", VisibleDropDown:=False
            '// Target 포함된 행만 선별
            rngAll.Copy .Cells(Rows.Count, "A").End(3)(2)
            '// 자동 필터된 값을 시트의 마지막 아래행에 복사하라
        End If
    End With
    rngC.AutoFilter  '// 자동필터 해제
    Columns.AutoFit  '// 열너비 자동 맞춤

    Set rngAll = Nothing  '// 변수 초기화
End Sub

AutoFilter를 이용한 셀 일치하는 Row 자동 가져오기 VBA

특정한 구분자를 넣으면 해당되는 것만 필터링 해서 가져오는 VBA 코드 입니다.

하는 방법은 필터링해서 가져오고자 하는 Sheet 를 선택합니다.

선택하고 나서 마우스 우클릭을 한 다음에 나오는 코드 보기를 누릅니다.

이런 창이 뜹니다. 여기에 아래 VBA Code를 붙여넣기 하고 나서 창을 닫으면 끝 입니다.

코드를 수정하고 싶으면 위 방법대로 코드를 보면서 수정하면 됩니다.

현재 부족한 부분은 work 시트에서 첫번째 머리글에 해당하는 것의 값과 서식만 복사해서 붙여넣는 걸 아직 처리를 못한 상태입니다. 나머지는 원하는 자료를 순식간에 가져오기가 됩니다.

첫줄 Private Sub Worksheet_Change(ByVal Target As Range) 를 다른 이름으로 변경하면 안되더라구요.

코드 설명은 A2 열의 값이 입력되면 가져오고 그렇지 않으면 동작되지 않도록 되어 있습니다.

완전자동필터VBA.vbs

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngAll As Range
    Dim rngC As Range
    Dim Taget As String

    If Target.Address <> "$A$2" Then Exit Sub
    If Target <> "" Then
        Application.ScreenUpdating = False      '// 화면 업데이트 (일시) 중지
        Range("A5").CurrentRegion.Offset(1).Clear    '// 기존 데이터를 전부 삭제
        Set rngAll = Sheets("work").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
        Set rngC = rngAll.Columns(1) '// 전체범위에서 선택할 열 1은 A열
        Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1)
        '// A2 행부터 범위 재지정
      
        With ActiveSheet  '// 해당 시트명 직접 입력
            rngC.AutoFilter 1, Target, , , False
             '// Target 만 필터링, 즉 Columns(1) 열에서 Target 과 일치하는 열만 필터링
             '// xlOr, xlAnd
             rngAll.Copy .Cells(Rows.Count, 1).End(3)(2)
             '// 자동 필터된 값을 연습 시트의 마지막 값이 들어있는 아래행에 복사하라
        End With
        rngC.AutoFilter  '// 자동필터 해제
        Columns.AutoFit  '// 열너비 자동 맞춤
     End if
End Sub 

그리고 아래 Code는 버튼을 누르면 A2 셀 값에 해당되는 조건에 맞는 것만 필터링해서 가져옵니다.

똑같은데 위에 있는 코드와 어떤 부분이 차이가 있는지 살펴보면 금방 아실 겁니다.

Sub AutoFilter_Copy()
    Dim rngAll As Range
    Dim rngC As Range
    Dim Taget As String

    Target = Cells(2, 1).Value      '// 조건 검색어

    If Target <> "" Then
        Application.ScreenUpdating = False      '// 화면 업데이트 (일시) 중지
        Range("A5").CurrentRegion.Offset(1).Clear   '// 기존 데이터를 전부 삭제
        Set rngAll = Sheets("work").Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
        Set rngC = rngAll.Columns(1) '// 전체범위에서 선택할 열 1은 A열
        Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1)
        '// A2 행부터 범위 재지정
       
        With ActiveSheet  '// 해당 시트명 직접 입력
            rngC.AutoFilter 1, Target, , , False
            '// 현재 시트(ActiveSheet)에서  Target 만 자동 선별
            '// xlOr, xlAnd
            rngAll.Copy .Cells(Rows.Count, 1).End(3)(2)
             '// 자동 필터된 값을 시트의 마지막 값이 들어있는 아래행에 복사하라
        End With
        rngC.AutoFilter  '// 자동필터 해제
        Columns.AutoFit  '// 열너비 자동 맞춤
    End If
End Sub

색상별로 시간합계 구하기 (SumIF 함수 사용)

배경색상별로 합계를 구하는 VBA Code 입니다.

기존 자료에 비해서 코드가 더 최적화되어 결과를 산출하는 속도가 빠릅니다.

더 빠르게 최적화 하는 방법도 가능할 거 같은데 아직은 능력이 부족하여 ㅠㅠ

Option Explicit
Sub SameColor_SumIF()
    Dim rngC, rngT As Range    '// 각 셀을 넣을 변수
    Dim rngData, tempData As Range  '// 전체 데이터 영역을 넣을 변수
    Dim sumData As Range      '// Data 시트 합계를 낼 영역 변수
    Dim rngVariable As Range  '// 구분자 영역 변수
    Dim i As Integer
    Dim oldTime As Single       '// 걸린 시간 구하는 변수 지정
   
    oldTime = Timer     '// 시간 변수 설정
    Application.ScreenUpdating = False        '//화면 업데이트 (일시) 정지
    Set rngData = Range([B2], Cells(Rows.Count, "B").End(3))
    Set sumData = Range([B2], Cells(Rows.Count, "B").End(3))
    Set rngT = [D2]
    Columns("D:E").EntireColumn.Clear   '// 값을 산출할 열 전체를 초기화
   
    '-------------------- C열에 색상 및 색상값 복사 ---------------------------
    For Each rngC In rngData
        rngC.Offset(0, 1).Value = rngC.Interior.ColorIndex
        rngC.Offset(0, 1).Interior.ColorIndex = rngC.Interior.ColorIndex
    Next rngC
    '-------------------- C열 기준으로 색상 및 합계 구하기 --------------------
    Set tempData = Range([C2], Cells(Rows.Count, "C").End(3))
    For Each rngC In tempData
        Set rngVariable = Range(rngT, rngT.End(4))  '// 범위가 계속 변함
        '// COUNTIF(범위,조건) : 범위에서 조건에 맞는게 몇개인지 카운트하라
        If Application.CountIf(rngVariable, rngC) = 0 Then
            rngT.Offset(i) = rngC
            rngT.Offset(i).Interior.ColorIndex = rngC.Interior.ColorIndex
            rngT.Offset(i, 1) = Application.SumIf(tempData, rngC, sumData)
            i = i + 1
        End If
    Next rngC
    '--------------- 가운데 정렬, 선그리기, 시간표시, 내림차순 정렬 ----------------------
    With ActiveSheet   '// 현재 시트
        .Cells(1, "D").Value = "색상"
        .Cells(1, "E").Value = "시간합계"
        '--------------- 가운데 정렬, 선그리기 ----------------------------
        .Range(.[D1], .Cells(Rows.Count, "E").End(3)).HorizontalAlignment = xlCenter
        .Range(.[E2], .Cells(Rows.Count, "E").End(3)).NumberFormat = "h:mm:ss" '// 시간표시
        .Range(.[D1], .Cells(Rows.Count, "E").End(3)).Borders.LineStyle = 1     '// 사용영역 선그리기
        .Range(.[D1], .Cells(Rows.Count, "E").End(3)).Sort .[E2], 2    '// 값을 내림차순으로 정렬
    End With
    '---------------- D열 색상만 남기고 값은 지우기 -------------------------------------
    Columns(3).EntireColumn.Clear    '// 임시로 값을 복사했던 열 초기화
    Range(rngT, rngT.End(4)).ClearContents   '//D2 부터 내용 삭제
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------------
    Set rngData = Nothing

    Set rngVariable = Nothing

    Set sumData = Nothing   
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

SameColor_SumIF.vbs

SameColor_SumIF.xlsm

VBA Code 파일 첨부합니다.

색상 개수와 색깔 표시하기 (동일 시트) - CountIF 함수 이용

동일한 값이 3번 이상 들어간 경우 색상을 넣어서 표시하고 싶다면?

CountIF 함수를 사용해서 중복되지 않는 값과 몇번이나 들어간 것인지 산출하고 나서

내림차순 정렬을 한 다음에 색깔이 들어간 갯수만큼 다른 색으로 원 데이터에 색깔을 칠하고 VBA Code 입니다.

이 코드가 속도가 훨씬 더 빠릅니다.

Option Explicit
Sub CellCnt_Countif()
    Dim rngC, rngT As Range    '// 각 셀을 넣을 변수
    Dim rngData As Range        '// 전체 데이터 영역을 넣을 변수
    Dim rngVariable As Range  '// 구분자 영역 변수
    Dim i As Integer

    Set rngData = Range([A2], Cells(Rows.Count, "D").End(3))
    Set rngT = [G2]
    Columns("G:H").EntireColumn.Clear   '// 값을 산출할 열 전체를 초기화
   
    For Each rngC In rngData
        Set rngVariable = Range(rngT, rngT.End(4))
        '// COUNTIF(범위,조건) : 범위에서 조건에 맞는게 몇개인지 카운트하라
        If Application.CountIf(rngVariable, rngC) = 0 Then
            rngT.Offset(i) = rngC
            rngT.Offset(i, 1) = Application.CountIf(rngData, rngC)
            i = i + 1
        End If
    Next rngC
   
    With ActiveSheet   '// 결과를 표시할 Sheet 선택
        .Cells(1, "G").Value = "구분"
        .Cells(1, "H").Value = "횟수"
        '--------------- 가운데 정렬, 선그리기 ----------------------------
        .Range("G1").CurrentRegion.HorizontalAlignment = xlCenter
        .Range(.[H2], .Cells(Rows.Count, "H").End(3)).NumberFormat = "#,###" '// 셀서식 : 3단위 콤마
        .Range(.[G1], .Cells(Rows.Count, "H").End(3)).Borders.LineStyle = 1     '// 사용영역 선그리기
        .Columns(7).CurrentRegion.Sort .[H2], 2    '// 값을 내림차순으로 정렬
    End With
  
    '------------------ 색상 칠하기 -----------------------------------------------
    For Each rngC In Range("G2", Cells(Rows.Count, "G").End(3))
       Call ColSet(rngData, rngC, rngC.Offset(0, 1))
    Next rngC
      
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------
    Set rngData = Nothing
    Set rngVariable = Nothing
  
    MsgBox "작업완료"  
End Sub

Function ColSet(rngAll, cell, Val) As Long
    Dim rngC As Range
    Dim i As Long
    For Each rngC In rngAll
        If rngC.Value = cell.Value Then
            Select Case Val.Value
                Case 3: rngC.Font.Color = vbRed
                Case 4: rngC.Font.Color = vbBlue
                Case Else: rngC.Font.Color = vbBlack
            End Select
        End If
    Next rngC
End Function

동일색상처리_Coutif.xlsm

CellsCnt_Countif.vbs

업체별 공급가액 합계 및 정렬 2 (SUMIF 함수 사용)

지난번에는 검사하는 로직이 너무 단순 무식한 방법이라 이번에는 COUNTIF 함수와 SUMIF 함수를 이용하여 가져오는 걸 해봤습니다.

VBA Code 입니다.

Option Explicit
Sub 업체별공급가합계()
    Dim rngC As Range           '// Data 시트 각 셀을 넣을 변수
    Dim rngData As Range        '// Data 시트 전체 영역 변수
    Dim sumData As Range      '// Data 시트 합계를 낼 영역 변수
    Dim rngT As Range           '// 결과 시트 변수
    Dim rngVariable As Range    '// 결과 산출 변수
    Dim i, j As Integer
    Dim oldTime As Single       '// 걸린 시간 구하는 변수 지정
   
    oldTime = Timer     '// 시간 변수 설정
    Application.ScreenUpdating = False        '// 화면 업데이트 (일시) 정지
    Set rngData = Range(Sheets("매출장").[B2], Sheets("매출장").Cells(Rows.Count, "B").End(3))
    Set sumData = Range(Sheets("매출장").[E2], Sheets("매출장").Cells(Rows.Count, "E").End(3))
    Set rngT = Sheets("업체별").[A2]    '// 결과를 도출할 영역 설정
    rngT.CurrentRegion.Offset(1).Clear
   
    For Each rngC In rngData
        Set rngVariable = Range(rngT, rngT.End(4)) 
        '// COUNTIF(범위,조건) : 범위에서 조건에 맞는게 몇개인지 카운트하라

          '// SUMIF(조건범위, 조건, 합계범위)
        If Application.CountIf(rngVariable, rngC) = 0 Then
            rngT.Offset(i) = rngC
            rngT.Offset(i, 1) = Application.SumIf(rngData, rngC, sumData)
            rngT.Offset(i, 2) = Application.SumIf(rngData, rngC, sumData) * 0.1
            rngT.Offset(i, 3) = Application.SumIf(rngData, rngC, sumData) * 1.1
            'rngT.Offset(i, 4) = Application.CountIf(rngData, rngC)     '// 중복횟수
            i = i + 1
        End If
    Next rngC
   
    With Sheets("업체별")   '// 결과를 표시할 Sheet 선택
        '--------------- 가운데 정렬, 선그리기 ----------------------------
        .Range("A1").CurrentRegion.HorizontalAlignment = xlCenter
        .Range(.[B2], .Cells(Rows.Count, "D").End(3)).NumberFormat = "#,###" '// 셀서식 : 3단위 콤마
        .UsedRange.Borders.LineStyle = 1     '// 현재시트 사용영역 선그리기
        .Range("A2").CurrentRegion.Sort key1:=Range("B2"), order1:=xlDescending  '// 내림차순 정렬
    End With
      
    MsgBox "총 " & Format(Timer - oldTime, "#0.00") & " : 초 소요"
End Sub

매출장_2.xlsm

AutoFilter로 시트별로 분리 저장

구분자별로 필터를 사용하여 시트별로 분리 저장하고자 할 경우 사용하는 VBA Code 입니다.

여기서의 키포인트는 Range.AutoFilter 메서드 입니다.

expression.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown)

- Field : 목록의 맨 왼쪽 필드가 1번 필드

- Criteria1 : 찾을 조건,  공백 필드 조건은 "=" 사용, 공백필드 아닌 조건은 "<>", 지정하지 않으면 모든 필터

- Operator : 필터의 종류를 지정하는 XlAutoFilterOperator 상수 중 하나

-  Criteria2 : 두번째 찾을 조건

- VisibleDropDown : False이면 필터링된 필드에서 자동 필터 드롭다운 화살표를 숨김

                         True이면 필터링된 필드에서 자동 필터 드롭다운 화살표를 표시

Option Explicit
Sub AutoFilter_Sheet_Split()
    Dim rngAll As Range    '// 전체 범위 지정 변수
    Dim rngC As Range
    Dim i As Integer

    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    Set rngAll = Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
    Set rngC = rngAll.Columns(1) '// 전체범위에서 선택할 열 1은 A열
    Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1)
    '// A2 행부터 범위 재지정

    For i = 2 To Worksheets.Count   '// 2번째 시트부터 전체 시트만큼 순환
        With Worksheets(i)  '// 해당 시트명, 2번째, 3번째,,,,
             rngC.AutoFilter 1, .Name, , , False     '// 숫자1은 A열 필터
             '// .Name 은 시트명 이름. 따라서 시트명 이름과 동일한 것을 필터함
             '// .Name 은 Worksheets(i).Name 을 의미
             rngAll.Copy .Cells(Rows.Count, 1).End(3)(2)
             '// 필터된 값을 해당 시트(Worksheets(i))의 마지막 값이 들어있는 아래행에 복사하라
        End With
    Next i
   
    rngC.AutoFilter     '// 자동필터 해제
    Application.ScreenUpdating = True

End Sub

Sub AutoFilter_Copy()
    Dim rngAll As Range
    Dim rngC As Range
    Dim CateName
   
    CateName = InputBox("구분자를 입력하세요")
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시) 중지
    Set rngAll = Range("A1").CurrentRegion '// A1 열과 연결된 인접셀 영역
    Set rngC = rngAll.Columns(1) '// 전체범위에서 선택할 열 1은 A열
    Set rngAll = rngAll.Rows(2).Resize(rngAll.Rows.Count - 1)
    '// A2 행부터 범위 재지정
   
    With Worksheets("연습")  '// 해당 시트명 직접 입력
        rngC.AutoFilter 1, CateName, , , False     '// 숫자1은 A열 필터
         '// 현재 시트(ActiveSheet)에서 CateName 만 자동 선별
         rngAll.Copy .Cells(Rows.Count, 1).End(3)(2)
         '// 자동 필터된 값을 연습 시트의 마지막 값이 들어있는 아래행에 복사하라
    End With
       
   rngC.AutoFilter  '// 자동필터 해제
   Application.ScreenUpdating = True
End Sub

위 VBA Code 입니다. 필요하신 분은 받아가세요.

구분자별자동필터로분리.vbs

vbs 첨부파일은 텍스트에디터로 열어서
엑셀에서 Alt + F11 눌러서 나오는 VBA Editor 창에서
[삽입] - [ 모듈] 눌러서 생성되는 화면에다가
붙여넣기를 하면 됩니다.

조건을 만족하지 않는 행을 삭제하는 VBA Code

조건 : A행은 11개의 숫자로 이루어져 있는데 조건을 만족하지 않는 행(Row)은 삭제하라

Sub 행삭제()
    Dim i, r, Counter As Integer
    Dim rngAll As Range        '// 범위 전체 영역 변수

    Application.ScreenUpdating = False        '화면 업데이트 (일시) 정지
    Cells(2, "A").Select    '// 현재 어느셀에 위치하든 A2 셀을 선택하라
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    '// 시작행 A2, 마지막행 자동인식
    Counter = rngAll.Rows.Count

    For i = 1 To Counter
        If Len(ActiveCell.Value) <> 11  Or Not IsNumeric(ActiveCell.Value) Then 

            '// 현재 셀의 길이가 11이 아니거나 숫자가 아니면
            Selection.EntireRow.Delete     '//해당행 전체 삭제
            Counter = Counter - 1          '// 행이 삭제되어 전체행 수를 하나 줄임
            r = r + 1         '// 삭제된 행의 수를 카운트
        Else
            ActiveCell.Offset(1, 0).Select    '// 아래행으로 이동
        End If
    Next i
    Msgbox "총" & r & "행 삭제"
End Sub

조건불만족행삭제.vbs

찾는 글자색에 색상을 주는 FIND VBA

'하나를 하더라도 최선을'님이 만들어 주신 VBA Code 입니다.

찾고자 하는 특정 단어만 다른 색으로 변경하고 싶을 때

가령 팀장이라는 단어만 찾아서 색깔을 파란색으로 변경하고 싶다고 하면

FIND VBA 를 이용하여 단어를 찾아서 바로 글자색을 변경한다.

Characters(start, length)에서 start 는 시작 문자 번호이며 length는 글자 수

InStr 함수는 한 문자열 안에 특정 문자열이 처음으로 나타난 위치를 정수(Long) 값으로 반환

  - InStr(start, 검색되는 문자식, 찾을 문자식, compare)

  - start 를 지정하지 않으면 첫 문자에서 검색을 시작

  - start 와 compare 는 선택요소로 생략해도 된다.

  - 반환할 위치가 없으면(찾을 문자식이 없으면) 0 을 반환한다. 따라서 IF 조건문에서 활용되기도 한다.

Option Explicit
Sub Character_ColorSet()
    Dim rngTarget As Range     '//대상 범위 지정변수
    Dim C As Range
    Dim FindText As String
    Dim strAddr As String
    Dim S As Integer
   
    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지
    Set rngTarget = ActiveSheet.UsedRange
    'Set rngTarget = Range([A1], Cells(Rows.Count, "C").End(3))
    '// End(3) 은 End(xlUp), 데이터가 있는 마지막행까지 자동으로 찾음
   
    FindText = InputBox("검색할 문자 입력") '//검색할 문자를 변수에 넣음
   
    With rngTarget
        .Font.Bold = False
        .Font.ColorIndex = xlAutomatic
        Set C = .Find(what:=FindText, lookat:=xlPart)
       
        If Not C Is Nothing Then
            strAddr = C.Address '// 찾은 셀의 주소를 변수에 넣음
            Do
                S = 1
                Do
                    With C.Characters(Start:=InStr(S, C, FindText), Length:=Len(FindText)).Font
                          '.Bold = True   '// 굵은 글씨로 표시하고 싶으면
                           .Color = vbBlue '// 글자색 표시, vbGreen 녹색 vbRed 빨간색
                    End With
                    S = InStr(S, C, FindText) + Len(FindText)
                Loop While InStr(S, C, FindText)
                Set C = .FindNext(C) '// 다음 찾은 데이터를 변수에
            Loop While Not C Is Nothing And strAddr <> C.Address
            '// 검색 일치하지 않거나 처음 찾은 셀이 아닐때까지 무한 반복
        End If
   
    End With
   
    Set rngTarget = Nothing '// 변수 초기화
End Sub

결과는 아래 보는 것과 같이 찾는 단어가 같은 셀에 여러번 들어가도 찾을 수 있다는 것입니다.

특정단어찾기VBA.xlsm

======================================================================

★ 여러 단어 검색하는 코드(하나를 하더라도 최선을 님이 작성한 코드)

Sub Character_ColorSet()
    Dim rngTarget As Range '//대상 범위 지정변수
    Dim C As Range
    Dim FindText As String
    Dim strAddr As String
    Dim S As Integer
   
    Application.ScreenUpdating = False  '//화면 업데이트 일시 정지
    Set rngTarget = ActiveSheet.UsedRange
    'Set rngTarget = Range([A1], Cells(Rows.Count, "C").End(3))
    '// End(3) 은 End(xlUp), 데이터가 있는 마지막행까지 자동으로 찾음

    FindText = InputBox("검색할 문자를 ,로 분리하여 입력(최대 3개)") '//검색할 문자를 변수에 넣음
    Dim V As Variant
    V = Split(FindText, ",")
    If UBound(V) > 2 Then MsgBox "최대 3개의 단어만 지원합니다.": End
   
    With rngTarget
        .Font.Bold = False
        .Font.ColorIndex = xlAutomatic
        Dim i As Integer
        For i = 0 To UBound(V)
            Set C = .Find(what:=V(i), lookat:=xlPart)
           
            If Not C Is Nothing Then
                strAddr = C.Address '// 찾은 셀의 주소를 변수에 넣음
                Do
                    S = 1
                    Do
                        With C.Characters(Start:=InStr(S, C, V(i)), Length:=Len(V(i))).Font
                        '.Bold = True   '// 굵은 글씨로 표시하고 싶으면
                        .Color = Choose(i + 1, vbBlue, vbRed, vbGreen) '// 글자색 표시, vbGreen 녹색 vbRed 빨간색
                        End With
                        S = S + InStr(S, C, V(i))
                    Loop While InStr(S, C, V(i))
                    Set C = .FindNext(C) '// 다음 찾은 데이터를 변수에
                Loop While Not C Is Nothing And strAddr <> C.Address
                '// 검색 일치하지 않거나 처음 찾은 셀이 아닐때까지 무한 반복
            End If
        Next
    End With
   
    Set rngTarget = Nothing '// 변수 초기화
End Sub

엑셀 작업을 하다보면 빈행을 숨기고 싶은 경우가 생깁니다.

하나 하나 지정하기 힘든데 이럴 경우에 한번에 숨기기가 가능한 VBA Code 입니다.

마지막 행(Row)은 A열 기준으로 잡은 것입니다.

검사하고픈 조건식이 들어있는 열은 B열 또는 C열인 경우입니다.

둘중에 어떤 것을 써도 결과는 동일합니다.

그리고 숨긴행을 다시 숨기기 취소하면 다 보이니까 잘못될까 걱정할 필요는 없구요.

Sub 빈행숨기기()
    Dim i As Long                    '// 변동되는 변수
    Dim endRow As Long        '// 마지막 행 변수

    endRow = Cells(Rows.Count, "A").End(3).Row    '// 값이 들어있는 마지막행을 자동인식
    For i = endRow To 2 Step -1        '// 마지막 행부터 거꾸로
        If (Cells(i, "B") = "" And Cells(i, "C") = "") Or Cells(i, "B") = 0 Or Cells(i, "C") = 0 Then
            Rows(i).EntireRow.Hidden = True     '// 빈행 숨기기
        End If
    Next i
End Sub

Sub 빈행숨기기1()
    Dim i As Long                    '// 변동되는 변수
    Dim endRow As Long        '// 마지막 행 변수

    endRow = Cells(Rows.Count, "A").End(3).Row    '// 값이 들어있는 마지막행을 자동인식
    For i = 2 To endRow        '// 검사할 행이 2행인 경우 2행부터 마지막행까지
        If (Cells(i, "B") = "" And Cells(i, "C") = "") Or Cells(i, "B") = 0 Or Cells(i, "C") = 0 Then
            Rows(i).EntireRow.Hidden = True     '// 빈행 숨기기
        End If
    Next i
End Sub

업체별 공급가액 합계 및 정렬 방법1

업체별 공급가액을 합친 금액을 자동 계산하는 VBA 코드입니다.

원본 데이터는 다른 시트에 있고 현재 시트에서 가져오고자 하는 걸 가져오는 것입니다.

이런 결과를 가져오구요.

아래는 VBA Code 입니다. F8키를 눌러서 버그가 있는지 일일이 점검해서 완벽하게 동작합니다.

Option Explicit
Sub 업체별공급가합계()

    Dim rngC As Range    '// 각 셀을 넣을 변수
    Dim rngAll As Range  '// 색상 전체 데이터 영역을 넣을 변수
    Dim cnt, i, j As Long
    Dim Sum_Cnt As Double   '// 상황에 따라 Long, Double 지정
   
    Application.ScreenUpdating = False        '화면 업데이트 (일시) 정지
   
    Cells(1, "A").CurrentRegion.Offset(1).Clear  '// 기존 데이터 삭제
   
    '-------------------- Sheets("매출장") B열을 복사 ----------------------------------
    For i = 2 To Sheets("매출장").Cells(Rows.Count, "B").End(3).Row
        Cells(i, "A").Value = Sheets("매출장").Cells(i, "B").Value
    Next i
  
    '-------------------  중복값 모두 제거 ----------------------------
    For i = 2 To Cells(Rows.Count, "A").End(3).Row          '// A열 각셀을 순환
        For j = i + 1 To Cells(Rows.Count, "A").End(3).Row
            If Cells(i, "A") = Cells(j, "A") Then
               Cells(j, "A").Delete Shift:=xlUp         '// 셀을 위로 밀면서 삭제
               j = j - 1                                '// 셀이 삭제되었으므로 변수 1을 빼줌
            End If
        Next j
    Next i

    '------------------- 같은 이름별로 공급가액 더하기 --------------------------------
    Sum_Cnt = 0
    Set rngAll = Range([A2], Cells(Rows.Count, "A").End(3))
    For Each rngC In rngAll
        For i = 2 To Sheets("매출장").Cells(Rows.Count, "B").End(3).Row
            If rngC.Value = Sheets("매출장").Cells(i, "B").Value Then
                Sum_Cnt = Sum_Cnt + Sheets("매출장").Cells(i, "E").Value   '//공급가액 열
                rngC.Offset(0, 1).Value = Sum_Cnt
            End If
        Next i
        rngC.Offset(0, 2).Value = rngC.Offset(0, 1).Value * 0.1   '// 부가세 10%
        rngC.Offset(0, 3).Value = rngC.Offset(0, 1).Value + rngC.Offset(0, 2).Value
        Sum_Cnt = 0
    Next rngC
   
    '--------------- 셀 서식지정 및 가운데 정렬, 선그리기 ----------------------------
    Range([B2], Cells(Rows.Count, "D").End(3)).NumberFormat = "#,###" '// 셀서식 : 3단위 콤마
    Range("A1").CurrentRegion.HorizontalAlignment = xlCenter
    ActiveSheet.UsedRange.Borders.LineStyle = 1     '// 현재시트 사용영역 선그리기
   
    '-------------------- 내림차순 정렬 (필요한 경우에만 하면 됨) -------------------------------
    With Range("A2").CurrentRegion
        .Sort key1:=Range("B2"), order1:=xlDescending
    End With
   
    '------------------ 개체변수 초기화(메모리 비우기) -----------------------------
    Set rngAll = Nothing
   
    MsgBox "작업완료"
   
End Sub

첨부파일 첨부하니 필요하신 분은 받아가세요.

매출장.xlsm