폴더와 하위 폴더에 있는 파일명들을 텍스트로 추출하기

폴더에 자료가 너무 많아서 원하는 자료를 결과작업을 하기가 힘든 경우가 있습니다.

이런 경우에는 기본적인 DOS 명령어를 활용하고 엑셀을 이용해서 편집하면 편합니다.

원하는 폴더로 이동하기 편하게 하는 가장 좋은 방법으로 Total Commander 를 사용합니다.

토탈커맨더는 파일 작업하는데 편하고 좋은 기능 들이 엄청 많이 있습니다.

dir 기본적이 명령어를 알고 싶다면 dir /? 로 확인하면 됩니다.

파일이 저장된 것을 확인할 수 있습니다.

dir /w/s >fileName.txt
dir /s/b >fileName.txt
dir *.mp3 /w/s >fileName.txt

/s는 서브디렉토리(폴더)까지 검색하는 옵션
/b는 파일사이즈, 날짜 등을 표시하지 않고 간단히 보여주는 옵션
/d는 한줄로 저장하고 싶을 때
/w는 한줄에 여러개의 파일을 동시에 저장하고 싶을 때
*.mp3 는 mp3 파일만 서브디렉토리까지 전부 추출

이렇게 저장된 파일을 엑셀VBA 를 이용하여 읽어들여서 편집하여 원하는 결과를 찾아낼 수가 있습니다.

.

좌우공백 제거

자료 정리를 하다보니 공백제거 하는게 정말 중요하다는 걸 느끼고 있어서 적어봅니다.

자료를 정리해서 서버 DB에 업로드하는데 업로드할 때 중복여부를 체크합니다.

분명히 DB에 있는 자료인데 없는 자료라고 인식하여 중복 등록되는 현상이 생기네요.

원인이 뭘까하고 열심히 파악 해봤더니 좌우 공백이 있는채 올라가거나, 유령문자, 쿼터(')처리 때문에 중복검사를 하면 중복이 제대로 검사가 안되더라구요.

누구나 다 아는 쉬운것에서 발생하는 사소한 실수가 엄청난 결과를 초래하기도 한다는 걸 다시금 깨닫게 되어 공백제거를 할 때 몇개나 공백이 제거 되었는지, 그리고 길이를 한번 파악해보려고 적어본 겁니다.

인터넷상에서 자료를 긁어온 경우나 시스템에서 받아온 자료에 유령문자가 있을 수 있습니다.

Sub 좌우공백제거()
    Dim rngC As Range    '// 각 셀을 넣을 변수
    Dim rngAll As Range        '// 전체 데이터 영역을 넣을 변수
    Dim i As Integer          '// 중복 개수를 카운트할 변수
   
    i = 0
    Set rngAll = Range([C2], Cells(Rows.Count, "C").End(3))   '// 공백제거 검사를 할 셀을 C열로 지정
    Range([H1], Cells(Rows.Count, "I").End(3)).Offset(1).Clear   '// 공백제거 표시할 열이 설정된 값 초기화
 
    For Each rngC In rngAll
        If rngC <> Trim(rngC) Then
            rngC.Offset(0, 5) = Len(rngC)    '// 검사하는 셀에서 우측으로 5번째에 길이를 표시하라
            rngC = Trim(rngC)   '// 좌우 공백 제거
            rngC.Offset(0, 6) = Len(rngC)   '// 검사하는 셀에서 우측으로 6번째에 공백제거한 길이를 표시하라
            i = i + 1
        End If
    Next rngC
   
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & i & "개 공백제거"

End Sub

글꼴 정리

글꼴을 깔끔하게 정리하고 싶을 때 사용하면 됩니다.

AcitveCell 이란 현재 커서가 있는 셀을 말합니다. 현재 커서가 있는 셀을 기준으로 해서 정리를 합니다.

Sub 글꼴정리()
    Dim rngTarget As Range
    Dim rngC As Range
 
    Application.ScreenUpdating = False      '// 화면 업데이트 (일시)정지
    ActiveCell.Select
    Set rngTarget = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
 
    For Each rngC In rngTarget
        With rngC
           .Font.Name = "Tahoma"
           .Font.Size = 11
           .Font.Color = vbBlack
           .Font.Bold = False
        End With
        With rngC.Offset(0, 1)
           .Font.Name = "맑은 고딕"
           .Font.Size = 10.5
           .Font.Color = vbBlack
           .Font.Bold = False
        End With
        With rngC.Offset(0, 2)
           .Font.Name = "맑은 고딕"
           .Font.Size = 10.5
           .Font.Color = vbBlack
           .Font.Bold = False
        End With
    Next rngC
    Set rngTarget = Nothing '// 변수 초기화
    'MsgBox "작업 완료"
End Sub

텍스트파일을 엑셀로 읽어서 정렬

엑셀 VBA 에서 텍스트 파일을 읽어들여서 셀을 나눠서 작업하기 위한 용도의 VBA Code.

현재 자료 하단에 자료를 추가하고 싶다면

    ActiveSheet.UsedRange.Clear 를 주석처리하고

    iRow = Cells(Rows.Count, "A").End(3).(2).Row 

라고 해주면 마지막 셀 하단에 자료가 추가가 됩니다.

구분자로 분리하고 싶지 않다면

        varTemp = Split(openTxt, ";")   '// 구분자로 읽어들인 하나의 행을 나눠서 배열에 저장
        Cells(iRow, 1).Resize(, UBound(varTemp) + 1) = varTemp '// 읽은 1행을, 엑셀 셀에 입력

대신에 Cells(iRow, 1).Value = openTxt '// 읽은 1행을, 엑셀 셀에 입력

Sub TextFile_To_ExcelRead()
    Dim openTxt As String
    Dim fileName As String
    Dim varTemp As Variant     
    Dim fileHandle As Integer
    Dim iRow As Long

    fileName = Application.GetOpenFilename("Text Files(*.txt),*.txt, Add-in Files (*.csv), *.csv", , "Please select text file...")
    If fileName = "False" Then     '//취소 선택 시 매크로 종료

        MsgBox "취소버튼이 선택되었습니다"   
        Exit Sub
    End If

    ActiveSheet.UsedRange.Clear   '// 현재 활성화된 시트에 있는 기존 데이터 전부 삭제

    iRow = 1     '// 활성화된 시트데이터를 지우지 않고 아래에 추가하고 싶다면 ??

    Application.ScreenUpdating = False  '// 화면 업데이트 일시 정지
    fileHandle = FreeFile   '// 사용 가능한, 파일 핸들 번호 구하기
    Open fileName For Input As fileHandle    '// 파일 열기

    '// 텍스트 파일 한 줄씩 읽기 (한글 영문 모두 가능)
    Do While Not EOF(fileHandle)    '// 파일의 끝까지 반복
        Line Input #fileHandle, openTxt  '// 읽은 1줄을 변수 openTxt 에 대입
        '// Line Input#문은 열려 있는 순차 파일에서 하나의 행을 읽어서 String 변수에 저장
        varTemp = Split(openTxt, ";")   '// 구분자로 읽어들인 하나의 행을 나눠서 배열에 저장
        Cells(iRow, 1).Resize(, UBound(varTemp) + 1) = varTemp '// 읽은 1행을, 엑셀 셀에 입력
        iRow = iRow + 1        '// 다음 행에 입력하기 위해 행번호 증가
    Loop

    Close fileHandle    '// 위에서 연 파일 닫기
   
    Range("C1").Select
    Selection.AutoFilter    '// 첫줄 자동필터, 만약 필터가 적용되었다면 해제가 됨
    Columns("A:B").HorizontalAlignment = xlCenter  '// A열,B열 가운데 정렬
    Rows(1).HorizontalAlignment = xlCenter  '// 1행만 가운데 정렬
    Columns.AutoFit     '// 열너비 자동 맞춤

End Sub

내보내고 싶은 열만 텍스트 파일로 내보내기

작업을 하다보면 특정한 열만 내보내고 싶은 경우가 있습니다.

이럴 경우 아래 주황색으로 된 부분처럼 해주면 됩니다.

1. 행은 2행부터 자료가 있는 마지막 열까지

2. 열은 1열부터 7열까지, 즉 A열부터 G열까지

3. 실제 내보내기할 열은 A열, F열, G열

Sub TextExport()
'// 내보내고 싶은 열만 선택해서 텍스트 파일로 내보내기
    Dim iRow As Long, iCol As Integer
    Dim sTxt As String, fPath As String
    Dim FN As Integer

    FN = FreeFile
    fPath = ThisWorkbook.Path & "\update_data.csv"

    deLimiter = ";"     '// 구분자
    Open fPath For Output As #FN
        For iRow = 2 To Cells(Rows.Count, "E").End(3).Row   '// 행지정
            sTxt = vbNullString
            For iCol = 1 To 7   '// 열 지정
                If Cells(iRow, 7) = 1 Then
                    If (iCol = 1) Or (iCol = 6) Or (iCol = 7) Then
                        sTxt = sTxt & Cells(iRow, iCol) & deLimiter
                    End If
                End If
            Next iCol
            If Len(sTxt) Then Print #FN, Left(sTxt, Len(sTxt) - 1)
        Next iRow
    Close #FN   '// 작업을 마치고 파일을 닫는다
    MsgBox "내보내기 완료"
End Sub

현 시트내용을 서식 포함 여러개 파일로 분할 저장

열너비 및 서식까지 그대로 복사하면서 파일을 분할하여 내보내기하는 VBA 코드

Sub split_As_per_Rows()
    '// 지정한 행만큼씩 파일을 나눠서 저장하는 VBA
    Dim Counter As String
    Dim rngAll As Range                           '//모든 영역을 저장할 변수
    Dim SplitLine As Integer                      '//몇 행씩 나눌지를 정하는 변수
    Dim rowsCount As Long, colsCount As Integer   '//행 및 열의 갯수 저장할 변수
    Dim strPath As String                         '//파일저장 경로를 넣을 변수
    Dim i 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 = 1 To rowsCount Step SplitLine          '//SplitLine 만큼씩 증가하며 반복
        Set rngSplit = Range(Cells(i + 1, 1), Cells(i + SplitLine, colsCount))   '//나누어진 영역을 변수에 넣음
        Workbooks.Add                                 '//새로운 workbook을 생성
        rngAll.Rows(1).SpecialCells(2).Copy Cells(1, 1)      '//첫줄 제목을 각 workbook에 복사           
        rngSplit.Copy      '//2번째 행부터 SplitLine 만큼 나누어진 영역을 복사        
        With Cells(2, 1)
            .PasteSpecial Paste:=xlPasteColumnWidths  '//열너비 복사
            .PasteSpecial Paste:=xlPasteFormats       '//양식 복사
            .PasteSpecial Paste:=xlPasteValues       '// 값 복사
        End With
       
        Range("E1").Select
        Selection.AutoFilter    '// 첫줄 자동필터 지정
               
        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

노래가사 파일로 내보내기

노래 가사를 파일로 내보내기를 하고 싶은 경우가 있어서 엑셀 VBA 를 이용하여 내보내기를 해 본 적이 있습니다. 아래 VBA Code 는 지금보다 더 초보시절에 최선을님께서 만들어주신 겁니다.

노래가사 파일형식은 lrc 로 되어 있고요. 내용은 텍스트형식으로 되어 있습니다.

아래 코드에 대해 간략하게 설명을 하자면.....

1. 파일경로가 있는지 검사하고 없다면 파일경로 폴더를 생성하라.

2. 파일로 내보낼 셀을 For Each 문을 이용하여 돌려라.

3. IF문으로 조건을 검사하여 윗셀과 아래셀을 검사하여 서로 같으면 내용을 같은 파일로 저장하고,

   다르면 파일에 저장하라.

4. 파일명을 생성하고 내용을 채워서 저장한다.

    - 파일에 데이터를 쓰기 위해서는 Print # 문을 사용한다.

    - Print #filenumber, output

    - Line Input # 문으로 읽어 온 데이터는 일반적으로 Print #을 사용하여 파일을 저장

Sub LRC내보내기()
    Dim ff As Integer
    Dim rngC As Range
    Dim Data As String
   
    If Len(Dir(ThisWorkbook.Path & "\lrc\", vbDirectory)) = 0 Then
        MkDir ThisWorkbook.Path & "\lrc"     '// 파일경로가 없을 경우 파일경로 생성
    End If
   
    Data = [B2] & " " & [C2]   
    For Each rngC In Range([D3], Cells(Rows.Count, "D").End(3)(2))
        '// D3부터 D열 마지막셀까지 rngC에 할당하라
        '//.End(3)이면 마지막 셀이고, .End(3)(2)이면 마지막 셀 다음 셀
        If rngC.Offset(-1) <> rngC Then
           '// 순환하는 현재셀 rngC가 D3라면 rngC.Offser(-1)은 D2 셀이므로 바로 윗셀과 같지 않으면 이란 의미
            ff = FreeFile
            '// 변수에 파일 번호를 할당           
            Open ThisWorkbook.Path & "\lrc\" & rngC.Offset(-1).Text For Output As #ff  '// 텍스트 파일로 내보냄
            '// 파일을 연다. 파일번호는 #ff
                Print #ff, Data  '// Data의 내용을 텍스트 파일에 입력
            Close #ff  '// 작업을 마치고 파일을 닫는다           
            Data = rngC.Offset(, -2) & " " & rngC.Offset(, -1)
            '// 현재 순환하는 셀의 왼쪽 두번째 셀과 + 공백 + 왼쪽 첫번째 셀값을 변수에 넣음           
        Else
            Data = Data & vbNewLine & rngC.Offset(, -2) & " " & rngC.Offset(, -1)
        End If
    Next   
    MsgBox "완료!!", 64, "최선을"   
End Sub

VBA 중복개수 표시

CountIF 함수를 사용하여 중복된 것만 개수를 표시하는 VBA 코드입니다.

아래 코드를 활용할 경우 초보자는 주황색으로 표시된 부분만 고쳐서 이용하면 됩니다.

하는 방법은 엑셀에서 Alt + F11 키 누르면 나오는 창에서 [삽입] - [모듈] 누르고 나오는 화면에 코드를 복사하여 붙여넣기 하고요. 코드 사이에서 마우스 커서 놓고 F5키 누르면 됩니다.

Sub 중복개수표시()
    Dim rngC, rngT As Range    '// 각 셀을 넣을 변수
    Dim rngAll As Range        '// 전체 데이터 영역을 넣을 변수
    Dim rngVariable As Range  '// 변하는 영역변수
    Dim i As Integer

    Set rngAll = Range([C2], Cells(Rows.Count, "C").End(3))   '// C열 전체를 범위로 지정
    Set rngT = [C2]      '// 위가 [C2] 이면 똑같이 C2 로 지정
    Range([E2], Cells(Rows.Count, "E").End(3)).ClearContents   '// 중복을 표시할 열이 설정된 값 초기화
 
    For Each rngC In rngAll
        Set rngVariable = Range(rngT, rngC)
        '// COUNTIF(범위,조건) : 범위에서 조건에 맞는게 몇개인지 카운트하라
        If Application.CountIf(rngVariable, rngC) <> 1 Then  '// 1인 것은 표시하지 말라
            rngC.Offset(0, 2) = Application.CountIf(rngVariable, rngC)

               '// 중복된 숫자를 표시할 열로서 검사하는 열로부터 오른쪽 2번째 열에 표시하라
            i = i + 1
        End If
    Next rngC
    Set rngAll = Nothing  '// 변수 초기화
    MsgBox "총 " & i & "개 중복발생"
End Sub

이 코드를 이용하여 행의 수가 52000개 되는 우편번호 주소를 편집하여 검색했더니 overflow 가 나온다.

엑셀에서 제공하는 중복제거 함수를 이용했더니 순식간에 중복을 제거하고 결과를 알려준다.

그냥 무작정 이런 코드를 쓰는 것보다, 엑셀의 기본기능을 잘 이용하고 적절한 함수를 쓰는 것이 훨씬 더 빠른 결과를 가져올 수 있다는 걸 알게 되었다.

MySQL 데이터 엑셀로 가져오기

MySQL 데이터를 엑셀로 가져오는 VBA 코드입니다.

코드는 구글링해서 찾은 여러자료를 분석해서 알기 쉽게 다시 정리 했습니다.

Sub GetMysSQLData()
    Dim DBConn As ADODB.Connection
    Dim RS As ADODB.Recordset
    Dim sSQL As String
    Dim dbConnStr As String
    Dim i As Long, dbRow As Long

    Dim DB_host As Variant
    Dim DB_User As Variant
    Dim DB_pass As Variant
    Dim DB_Name As Variant
    
    Application.ScreenUpdating = False  '// 화면 업데이트 정지

    Set shtName = Worksheets("DB_Setting")   '// DB_Setting Sheet 에서 설정한 값을 가져온다
    Set DB_host = shtName.Range("A2")     '// IP  설정 값. 호스팅업체에서 알려준 접속 host URL
    Set DB_port = shtName.Range("B2")   '// PORT  설정 값. MySQL Port 는 3306 포트가 default
    Set DB_User = shtName.Range("C2")   '// User ID 설정 값
    Set DB_pass = shtName.Range("D2")   '// PASSWord  설정 값
    Set DB_Name = shtName.Range("E2")   '// DB명  설정 값

    Set DBConn = New ADODB.Connection
    dbConnStr = "DRIVER={MySQL ODBC 5.1 Driver};SERVER=" & DB_host & ";PORT=" & DB_port & ";DATABASE=" & DB_Name & ";USER=" & DB_User & ";PASSWORD=" & DB_pass & ";OPTION=3;"

    DBConn.Open dbConnStr   '// Open MySQL DB connection
    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
   
    '// SQL 문 작성
    'sSQL = "SELECT * FROM tblName"
    sSQL = "SELECT uid, name, email, sex FROM tblName"
   
    '// MySQL 데이터 가져오기
    RS.Open Source:=sSQL, ActiveConnection:=DBConn, CursorType:=adOpenDynamic, LockType:=adLockReadOnly, Options:=adCmdText

    RS.MoveFirst  '// Move to the first record
    Worksheets("TEST").Select   '// 다른 시트에 있어도 TEST 시트로 ActiveSheet 가 전환됨
    With Worksheets("TEST") '// Sheet 명을 지정한다
        .Range("A1:AZ1048576").ClearContents    '// 기존 데이터는 전부 삭제
        For i = 1 To RS.Fields.Count        '// MySQL 필드의 제목 가져다 뿌려준다
            .Cells(1, i).Value = RS.Fields(i - 1).Name
        Next i
   
        .Range("A2").CopyFromRecordset RS   '// MySQL 데이터를 A2 열부터 뿌려준다
       
        .Range([A1], Cells(1, RS.Fields.Count)).Select
        Selection.AutoFilter
        Cells(1, 2).Select
        .Columns.AutoFit      '// 전체열 열너비 자동맞춤
    End With
   
    '//Close connection again
    RS.Close
    DBConn.Close
    
    Set RS = Nothing
    Set DBConn = Nothing
End Sub

GetMysSQLData.xlsm

첨부된 샘플파일에 설명이 나와 있으니 수정해서 사용하면 됩니다.

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 참조하세요

셀 병합하기 및 셀 병합 해제

Sub MergeCells()
    Dim rngAll As Range     '// 선택영역 전체 범위 변수

    Dim iRow, iCol As Integer   '// 행, 열의 변수

    Dim rCnt As Integer      '// 병합할 셀의 크기 지정 카운트
      
    Set rngAll = Range([A2], Cells(Rows.Count, "C").End(3))
    Application.DisplayAlerts = False   '// 화면경고 중지
  
    For iCol = 1 To rngAll.Columns.Count
        For iRow = 1 To rngAll.Rows.Count
            If rngAll.Cells(iRow, iCol) = rngAll.Cells(iRow + 1, iCol) Then
                rCnt = rCnt + 1
            Else
                Range(rngAll.Cells(iRow, iCol), rngAll(iRow - rCnt, iCol)).Merge
                rCnt = 0
            End If
        Next
    Next
    Application.DisplayAlerts = True    '// 화면경고 복원
End Sub

Sub unMerge()
    Dim rngC As Range       '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range      '// 선택영역 전체 범위 변수
   
    Set rngAll = Range([A2], Cells(Rows.Count, "C").End(3))
    rngAll.Cells.MergeCells = False   '// 범위의 셀 전체를 선택해서 병합 해제   
End Sub

첨부한 VBA 코드는 셀 병합, 병합 해제, 윗셀의 값으로 채우기, 병합해제 및 값으로 채우기 에 대한 VBA 코드입니다.

이 코드 하나면 간단하게 셀 병합 해제는 편리하게 이용할 수 있을 겁니다.

수정해서 사용할 곳은 위 주황색 부분의 범위구간 설정하는 곳입니다.

나머지는 그대로 이용하면 됩니다.

Cell_Merge_unMerge.vbs

빈셀일 경우 윗셀의 내용으로 채우기

엑셀 작업을 하다보면 셀을 병합하거나 해제 등의 작업을 하게 됩니다.

이럴 때 편리하게 사용할 수 있는 간단한 VBA 코드입니다.

수정할 부분은 분홍색 구간범위 입니다.

Sub BlankCell_and_Fill()
'// 빈셀일 경우 윗셀의 내용으로 채우기
    Dim rngC As Range       '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range      '// 선택영역 전체 범위 변수
   
    Set rngAll = Range([A2], Cells(Rows.Count, "C").End(3))
   
    For Each rngC In rngAll     '// 선택 영역을 순환
        If IsEmpty(rngC) Then       '// 선택된 셀이 비어있다면
            rngC.Value = rngC.Offset(-1, 0).Value   '// 윗셀의 내용을 넣어라
        End If
    Next rngC
End Sub

셀 병합 해제하고 같은 값으로 채우기

아래 VBA 코드는 셀병합을 해제할 구간을 선택하고 셀병합전 값으로 채웁니다.

구간범위 설정하는 곳만 상황에 맞게 변경해주면 됩니다.

Sub unMerge_and_Fill()
    Dim rngC As Range          '// 선택영역 각 셀을 넣을 변수
    Dim rngAll As Range         '// 선택영역 전체 범위 변수
   
    Application.ScreenUpdating = False       '// 화면 업데이트 중지
    Set rngAll = Range([B2], Cells(Rows.Count, "C").End(3))
   
    For Each rngC In rngAll              '// 선택 영역을 순환
        If rngC.MergeCells Then         '// 선택 셀이 셀병합 되어 있다면
            With rngC.MergeArea            '// 셀 병합된 area를
                .UnMerge                   '// 셀 병합 해제
                .Value = rngC              '// 셀 병합 풀린영역 셀 병합전 값으로 채움
            End With
        End If
    Next   
    MsgBox "처리완료"
End Sub

날씨정보 추출

아래 코드는 다음의 날씨 정보를 편하게 추출하는 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

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

첫문자열 공백제거

네이버지식인에 나온 질문을 테스트해보려고 복사해서 붙여넣기를 했더니

이렇게 앞부분이 공백으로 나오는 경우가 있습니다.

trim 함수 이용하여 지워도 절대 지워지지 않더군요. trim 함수는 문자열의 앞뒤의 스페이스바 공백 (아스키값 32)만 지우는 겁니다.

Sub asc_value()
    Dim rngC As Range
    Dim rngAll As Range
    Dim temp As Variant
    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
    For Each rngC In rngAll
        temp = Asc(Left(rngC, 1))
        MsgBox temp
    Next rngC
End Sub

아스키 값을 알아냈다니 63 이라고 나오네요..

그래서

Sub 문자열변경()
    Dim rngAll As Range   
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
    rngAll.Replace What:=Chr(63), replacement:=""
End Sub

로 했더니....

이렇게 다 지워져 버리네요.. 알고보니 아스키값 63 은 ? 이더군요..

엑셀에서 ? 된 것은 모두를 뜻하여 전부 지워버린 거네요..

그래서 좀 불편하더라도

Sub 첫문자열공백제거()
    Dim rngAll As Range
    Dim rngC As Range
    Dim sName  As String
  
    ActiveCell.Select     '// 현재 커서가 있을 셀 선택
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
  
    For Each rngC In rngAll
        sName = Left(rngC, 1)     '// 첫번째 문자열 추출
        If Asc(sName) = 63 Or Asc(sName) = 32 Then    '//스페이스바의 아스키 값은 32
            rngC = Mid(rngC, 2, Len(rngC))       
        End If
    Next rngC  
End Sub

코드를 사용해서 첫문자열 공백을 제거했습니다.

아스키 코드값을 알아내도 잘못 사용하면 데이터가 원하지 않는 결과를 얻을 수도 있다는 걸 알았습니다.

엑셀에 삽입된 이미지만 일괄 삭제하는 방법

엑셀에 삽입된 그림이나 이미지만 지우고 싶은 경우가 있습니다.

하나 하나 일일이 지우려면 짜증나겠죠.

이럴 때 아래 그림처럼 하시면 바로 해결 됩니다.

이제 Deltet 키를 누르면 이미지가 다 지워집니다.

여러행 한꺼번에 삭제

가장 간단하게 여러행을 삭제하는 방법은 Range 범위를 주고 행을 삭제하는 것입니다.

메모리가 부족하다는 메시지가 나와서 아래 방법을 써봤는데 알고 보니까 엑셀 파일이 문제가 있었나 봅니다.

새로운 파일을 생성하고 데이터만 복사해서 아래 VBA 코드를 실행했더니 금방 금방 파일이 지워지더군요.

Sub 여러행삭제()
    Range([a2], [a1000]).EntireRow.Delete
End Sub

또다른 방법은

삭제할 행의 수를 입력받아서 지우는 방법입니다.

Cells(행,열) 이므로 Cells(Counter,1) 이라는 의미는 행의 수는 가변으로 받고, 열은 1 즉 A열을 의미합니다.

Sub 여러행삭제()
    Dim i As Integer
    Dim Counter
   
    Counter = InputBox("삭제할 행의 개수를 입력하세요")
    Range([a2], Cells(Counter, 1)).EntireRow.Delete
End Sub

범위(Range)를 주고 그 범위의 행 전체를 모두 삭제

Range(Cells(6, "A"), Cells(Rows.Count, "A")).EntireRow.Delete
// 의미 분석을 해보면 ....

// Cells(행,열) 이며, Cells(6,"A") 라는 것은 6번째행, 열은 A열 이라는 것임. 다르게 표현하면 Cells(6,1)

// 쓰는 사람에 따라 Cells(6,1)을 선호하는 분도 있음. 전 어떤 열인지 파악하기 좋게 영문표기를 선호

// Cells(Rows.Count, "A") 에서 Rows.Count 는 엑셀이 제공하는 최고의 행수를 의미

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

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

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

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

[VBA기초] 괄호 제거한 문자열 추출

괄호를 제외한 문자열을 일일이 수작업하는 것은 너무 번거로울 수가 있습니다.

이럴 경우에 아래 VBA 코드를 이용하면 매우 편리합니다.

부연 설명을 드리자면

    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
이 부분은 현재 커서거 있는 셀을 기준으로 그 열 전체를 선택하라는 의미입니다.

만약 B열 등 특정한 열만 선택하고자 한다면

Set rngAll = Range([B2], Cells(Rows.Count, "B").End(3))

이라고 범위를 지정하면 됩니다.

For Each 문은 정해진 구간을 무조건 반복하라는 의미입니다.

InStr 함수를 이용하여 (가 시작되는 위치를 반환하고, )가 시작되는 위치를 반환합니다.

이제 Left 함수와 Mid 함수를 이용하여 원하는 구간만 추출하고 & 로 묶어주고, 결과를 어디에 뿌릴 것인가만 정해주면 됩니다.

Sub 괄호제외한문자열추출()
    '// 문자열 중 ()괄호 밖의 문자열만 따로 추출하기
    Dim rngAll As Range '// 해당 영역을 변수로 지정
    Dim rngC As Range '// 셀을 지정
    Dim startChk As Byte '// (시작위치 변수 지정
    Dim endChk As Byte '// )끝위치 변수 지정
    Dim tmpString As String '// 추출 문자열 임시 저장 변수
 
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    ActiveCell.Select
    Set rngAll = Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3))
 
    For Each rngC In rngAll
        'rngC.Value = Trim(rngC.Value)
        startChk = InStr(rngC.Value, "(")
        endChk = InStr(rngC.Value, ")")
     
        '// ()를 제외한 문자열 추출
        tmpString = Left(rngC, startChk - 1) & Mid(rngC.Value, endChk + 1, Len(rngC) - endChk)
        rngC.Value = tmpString  '// 같은 열에 덮어쓰기
        'rngC.offset(0,1).Value = tmpString '// 바로 옆에 열에 기록하기   
    Next rngC
    Set rngAll = Nothing
    MsgBox "완료"
End Sub

 셀 중앙정렬

셀을 중앙정렬하는 VBA는 굳이 필요 없을 수도 있습니다.

Sub 셀중앙정렬()   
    ActiveCell.Select   '// 현재 커서가 있는 셀
    Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(3)).HorizontalAlignment = xlCenter
    MsgBox "완료"
End Sub

이제 커서를 위 VBA 코드 사이에 두고 F5키를 누르세요..