무성의한 블로그

조만간 정리해서..

서재를 정리해야겠다는 생각에 책을 이리저리 보다 보니 
앞으로도 영영 안 볼 책들이 좀 있어서 버릴려고 합니다. 
오래된 책이라 관심 있는 사람들이 있을까 싶지만 
혹시 필요한 책 있으면 연락 주세요. 
배송은 어려울 것같네요. 

을지로 입구역 시청방향으로 삼성화재 뒷편 YG빌딩에 있으니 

누구든지.

1. 중급회계 제 8판, 웅지세무대학 출판부, 2006년
2. 윈도우즈 임베디드 CE 프로그래밍(입문), 정보문화사, 2008
3. Mastering Web Application Development using Microsoft Visual InterDev 6.0, 정보문화사, 2000
4. 무선설비산업기사(필기), 세화 2008
5. Visual Basic 6 시작 그리고 완성, 대림, 1998
6. Visual Basic 6 Programming Bible, 정보문화사, 1999
7. Microsoft 한글 Visual InterDev 6.0 Programmer's guide, 영진출판사, 1998
8. Active Server Page 3.0, 정보문화사, 2000
9. 대한민국개발자희망보고서, 한빛미디어, 2007
10. 품질경영, 북코리아, 2010
11. 제국의역습, 밀리언하우스, 2009

그리고 정보시스템 감리에 관심이 있으신 분들을 위해 
12. 정보시스템 감리, 명경사, 1999

엑셀로 데이터를 처리한 후 이를 특정파일에 일일이 저장하는 것은 생각보다 번거로운 일입니다. 

가끔 잊어버리는 경우 백업본이 생성되지 않아 작업결과를 잃어버리기도 하지요. 

아래 코드는 자료 처리를 완료한 후 새로운 엑셀 파일을 만들거나 기존 파일에 작업결과를 저장하는 코드입니다. 

    ' 시트를 새로 만든다.

   ' 현재 작업 파일 정보를 저장한다. 

    orgBookName = ActiveWorkbook.Name

    '먼저 기존 파일 존재 여부 체크함.

    dFile = "C:\temp\result\"

    fFile = "점검결과-" & Year(Date) & Month(Date) & ".xlsx"

    newFileName = dFile & fFile

    Set fs = CreateObject("Scripting.FileSystemObject")

    fileChkTF = fs.fileexists(newFileName)

    '만약 파일이 있으면 기존 파일에 시트를 추가하고 시트명을 부여함.

    If fileChkTF = True Then

  Workbooks.Open newFileName

' 첫번째 시트 앞에 상세시트 추가

        Sheets.Add before:=Sheets(1)

' 시트명이 중복되지 않도록 시분초를 붙임

        Sheets(1).Name = "점검결과상세-" & Date & Hour(Time) & Minute(Time) & Second(Time)

'첫번째 시트 앞에 결과 시트 추가

        Sheets.Add before:=Sheets(1)

        Sheets(1).Name = "점검결과-" & Date & Hour(Time) & Minute(Time) & Second(Time)

    ' 만약 파일이 없으면 새로 파일을 만들어 시트명을 변경함.

    Else

        Workbooks.Add

        ActiveWorkbook.SaveAs Filename:=newFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

        Sheets(1).Name = "점검결과-" & Date & Hour(Time) & Minute(Time) & Second(Time)

        Sheets(2).Name = "점검결과상세-" & Date & Hour(Time) & Minute(Time) & Second(Time)

    End If

    '작업 파일 활성화, 시트 선택후 작업결과부분 복사

    Workbooks(orgBookName).Activate

    Sheets(2).Select

    ccCnt = Cells(5, 3)

    Range(Cells(3, 8), Cells(abCnt, 12)).Copy

   ' 백업 파일을 활성화하여 붙여 넣기    

    Workbooks(fFile).Activate

    Sheets(1).Select

    Cells(2, 1).Select

    ActiveSheet.Paste

  ' 필요할 경우 번호를 자동 부여 함. 

    Cells(2, 1) = 1

    Cells(3, 1) = 2

    Range("a2:a3").Select

    Selection.AutoFill Destination:=Range(Cells(2, 1), Cells(20000, 1))

    Cells(1, 1) = "제목"

    Cells(1, 2) = "세부내용"

    Cells(1, 3) = "수량"

    Cells(1, 4) = "비고"

   ' 다시 작업 파일 활성화 후 복사

    Workbooks(orgBookName).Activate

    Sheets(2).Select

    hcCnt = Cells(2, 17)

    Range(Cells(2, 16), Cells(hcCnt + 2, 18)).Copy

   ' 두번째 시트에 내용 입력    

    Workbooks(fFile).Activate

    Sheets(2).Select

    Cells(2, 1).Select

    ActiveSheet.Paste

    Cells(1, 1) = "날짜"

    Cells(1, 2) = "제목"

    Cells(1, 3) = "결과수"

  ' 저장후 종료                            

    ActiveWorkbook.Close SaveChanges:=True

   '점선 모양 반짝이는 선택 창을 비활성화

    Application.CutCopyMode = False

  ' 가장 앞 셀로 이동       

    Cells(1, 1).Select

해외 쇼핑몰에서 물건을 사올 때 비용계산하는 엑셀입니다. 

엑셀의 함수를 사용해서 만들었는데 오늘 마침 시간도 있고 해서 매크로로 변경했습니다. 

둘 다 올려놨으니 비교해보세요.

똑같은 기능은 아닙니다. 다만 함수를 사용하는 것과 다르다는 것을 참조하라는 겁니다. 

수입품_최종가격_계산표1.xlsm

수입품_최종가격_계산표1.xlsx

매크로 처음하시는 분들 참고하시라고 올려봅니다. 

아래 주소의 첨부 파일을 참조하세요. 

수입품_최종가격_계산표1.xlsm

Sub goCalcMoney()

'관세율

    tradeTaxRate = Cells(2, 2)

    addTaxRate = Cells(3, 2)

    moneyRate = Cells(4, 2)

    Range(Cells(13, 2), Cells(21, 7)).Value = 0

    k = 2

    Do While k < 8

        goodsMoney = Cells(8, k)

        InType = Cells(6, k)

        If goodsMoney < 1 Or goodsMoney = "" Then

        Else

            transFee = Cells(9, k)

            taxFee = Cells(10, k)

            weightAll = Cells(11, k)

            '1차 합계

            totalDallor = goodsMoney + transFee + taxFee

            sumKoreaWon = totalDallor * moneyRate

            Cells(13, k) = sumKoreaWon

            '과세운임

            i = 2

            Do While i < 999

                startWeight = Cells(i, 16)

                If startWeight < weightAll Then

                    i = i + 1

                Else

                    If sumKoreaWon > 200000 Then

                        transTaxFee = Cells(i - 1, 19).Value

                        Cells(14, k).Value = transTaxFee

                    Else

                        transTaxFee = Cells(i - 1, 18).Value

                        Cells(14, k).Value = transTaxFee

                    End If

                    i = 999

                End If

            Loop

            '과세기준

            standardTax = sumKoreaWon + transTaxFee

            Cells(15, k) = standardTax

            '관세

            If standardTax < 150000 Or InType = "목록" Then

                afterTax = sumKoreaWon

                afterAddTax = sumKoreaWon

                tradeType = "비과세"

            Else

                afterTax = standardTax * (1 + (tradeTaxRate / 100))

                afterAddTax = afterTax * (1 + (addTaxRate) / 100)

                tradeType = ""

            End If

            Cells(16, k) = afterTax

            Cells(17, k) = afterAddTax

            Cells(12, k) = tradeType

            '운송비

            i = 4

            Do While i < 999

                '몰테일 배송비

                mstartWeight = Cells(i, 10)

                If mstartWeight < weightAll Then

                    i = i + 1

                Else

                    mTransFee = Cells(i, 11).Value

                    i = 999

                End If

            Loop

            i = 4

            Do While i < 999

                '이하넥스 배송비

                estartWeight = Cells(i, 10)

                If estartWeight < weightAll Then

                    i = i + 1

                Else

                    eLTransFee = Cells(i, 13).Value

                    eNTransFee = Cells(i, 14).Value

                    i = 999

                End If

            Loop

            If mTransFee > eLTransFee Then

                If eLTransFee > eNTransFee Then

                    lastTransFee = eNTransFee

                    feeSource = "이하넥스 뉴저지"

                Else

                    lastTransFee = eLTransFee

                    feeSource = "이하넥스 LA"

                End If

             ElseIf mTransFee > eNTransFee Then

                lastTransFee = eNTransFee

                feeSource = "이하넥스 뉴저지"

             Else

                lastTransFee = mTransFee

                feeSource = "몰테일"

             End If

             wonLastTF = lastTransFee * moneyRate

             Cells(18, k) = wonLastTF

            If standardTax < 150000 Or InType = "목록" Then

                 Cells(19, k) = afterAddTax + wonLastTF

                 Cells(21, k) = afterAddTax - sumKoreaWon

            Else

                 Cells(19, k) = afterAddTax + wonLastTF - transTaxFee

                 Cells(21, k) = afterAddTax - sumKoreaWon

            End If

                 Cells(20, k) = feeSource

        End If

        k = k + 1

    Loop

End Sub

앞서 올린 매크로는 폴더에서 파일리스트를 읽어와서 엑셀시트에 뿌리는 기능입니다. 

오늘은 엑셀 시트에 뿌려진 파일을 하나씩 여는 기능을 소개합니다. 

엑셀 시트를 열고 첫번째 시트의 시트명과 A1 셀의 값을 읽어서 복사하고 시트 2에 붙이고 다시 닫는 기능입니다.

Sub testtt()

    '변수 선언 integer 는 32767 까지의 값만을 지원한다.

    Dim i As Integer

    Dim fileCnt As Integer           ' 파일의 수

    Dim sNo As Integer          ' 처리한 시트 수

    Dim cellPnt As Integer

    Dim f_name As String        '읽고자 하는 파일명

    Dim file_name As String      '파일명 전체

    '변수 기본값 할당

    i = 9           ' 첫 파일명이 아홉번째 줄에 있음.

    cellPnt = 2     ' 두번째 줄부터 써야 함.

    '처리할 파일의 갯수

    fileCnt = Sheets(1).Cells(8, 5).Value

    '매크로 파일명을 기록해 둡니다.

    orgBookName = ActiveWorkbook.Name

    ' 시트를 새로 만들어서 두번째 시트로 저장함. 시트명은 일자+시분초

    Sheets.Add after:=Sheets(1)

    Sheets(2).Name = Date & Hour(Time) & Minute(Time) & Second(Time)

    '반복하며 파일 처리 함

    ' 폴더열기 기능에서 파일을 읽어서 1번 시트의 9번째 위치부터 적었습니다.

    Do While i < fileCnt + 9

        sNo = 1

        '파일열기

        d_name = Sheets(1).Cells(i, 2).Value

        f_name = Sheets(1).Cells(i, 3).Value

        file_name = d_name + "\" + f_name

        Dim fs, f

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set f = fs.GetFile(file_name)

        '시트 수 만큼 반복하며 확인할 것

            Workbooks.Open Filename:=file_name

        Workbooks(f_name).Activate

   '시트를 숨기기 해둔 상태라면 읽지 못합니다. 그래서 숨김여부를 먼저 체크합니다.

        If Sheets(1).Visible = xlSheetVisible Then

            Sheets(1).Select

            sName = Sheets(1).Name

            cValue = cells(1,1).value

            '확인된 시트명을 결과시트에 적기

            Workbooks(orgBookName).Activate

            Sheets(2).Activate

            ActiveSheet.Cells(cellPnt, 1).Value = i - 8 '번호 적어주기

            ActiveSheet.Cells(cellPnt, 2).Value = sName '시트명 가져오기

            ActiveSheet.Cells(cellPnt, 3).Value = cValue '시트명 가져오기

            cellPnt = cellPnt + 1

        End If

        sNo = sNo + 1

    '파일 닫기, 열었던 파일을 경고창 없이 저장 없이 종료합니다. 

    Application.DisplayAlerts = False

    Workbooks(f_name).Close SaveChanges:=False

    i = i + 1

    Loop

    MsgBox ("작업을 완료하였습니다.")

End Sub

엑셀 시트에서 파일폴더를 열고 해당 파일 폴더와 하위 폴더의 파일들을 읽어오는 매크로입니다. 

업무 중에 필요한 부분이라 만들었습니다. 

엑셀 매크로 작성 방법은 엑셀에서 보기->매크로기록 기능을 사용해서 기본적인 기능을 확인한 후 필요한 부분을 개선하는 방식으로 했습니다. 

또 추가적으로 필요한 부분은 인터넷에서 검색하여 추가했습니다. 

필요하신 분은 참조해서 사용하세요. 

참고로 시트의 D4열에 필터 값을 입력해야 합니다. 

*.xls* 등의 형식으로 입력하면됩니다. 

Sub getFolder()

    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    ' 현재 있는 데이터를 모두 삭제해야 함.

    ' 첫번째 시트에서 작업을 합니다.

    Sheets(1).Activate

    ActiveSheet.Range("d3").Value = ""

    ActiveSheet.Range("b9:f10000").Value = ""

    ActiveSheet.Cells(8, 6).Value = 9

    '서브폴더의 내용을 가져옴

    ' folderspec에는 폴더 주소가 기재됩니다.

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

        .Title = "검색할 폴더를 선택 하세요"

        If .Show = -1 Then

            Range("d3") = .SelectedItems(1) '선택한 폴더명을 A3 셀에 저장

            folderspec = Range("d3").Value

            getSubFolder (folderspec)

        End If

    End With

End Sub

'하위폴더를 조회하는 기능입니다. 

Sub getSubFolder(folderspec)

    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    strDir = Range("d3").Value

    If strDir = "" Then

        MsgBox (" 선택된 폴더가 없습니다. 폴더를 선택하세요.")

        Exit Sub

    End If

    r = 8

    Sheets(1).Cells(r, 2) = "폴더명"

    Sheets(1).Cells(r, 3) = "파일명"

    Sheets(2).Range("a1:d1").Font.Name = "Arial"

     '이 소스는 인터넷에서 가져온것입니다. 

    r = r + 1

    If Trim(Right(strDir, 1)) <> "\" Then strDir = strDir & "\"

    strFilter = Range("d4").Value

    result = sRetrieve(strDir, strFilter, r)

    '여기까지.

End Sub

     '이 소스는 인터넷에서 가져온것입니다. 

Private Function sRetrieve(sPath As String, strFilter As String, r As Long) As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set dDirs = fs.getFolder(sPath)

    For Each dDir In dDirs.SubFolders

        sRetrieve = sRetrieve(dDir.Path, strFilter, r)

    Next

    For Each fFile In dDirs.Files

        If fFile.Name Like strFilter Then

            Sheets(1).Cells(r, 2) = fFile.parentfolder.Path

            Sheets(1).Cells(r, 3) = fFile.Name

            r = r + 1

        End If

    Next

    Set fs = Nothing

End Function

엑셀을 사용해서 색상표를 추출하는 매크로 입니다 .

사무실에서 필요해서 간단하게 만들었습니다. 

colortest.xlsm

Sub colorTest()

    ' 기본값 세팅

    Cells(1, 2) = "Red"

    Cells(2, 2) = "Green"

    Cells(3, 2) = "Blue"

    Cells(1, 4) = "RGB 값"

    Cells(1, 5) = "색상"

    ' 소수점 이하는 반올림

    rVal = Round(Cells(1, 3), 0)

    gVal = Round(Cells(2, 3), 0)

    bVal = Round(Cells(3, 3), 0)

    '반올림한 값을 다시 적어줌

    Cells(1, 3) = rVal

    Cells(2, 3) = gVal

    Cells(3, 3) = bVal

    Range(Cells(4, 1), Cells(4, 3)).Merge

    Cells(4, 1) = "* 소수점 이하 값은 반올림됩니다."

    Range(Cells(2, 4), Cells(256, 6)).Clear

    i = 1

    Do While i < 256

        nrVal = i * rVal

        If i * rVal > 255 Then

            nrVal = 255

        End If

        ngVal = i * gVal

        If i * gVal > 255 Then

            ngVal = 255

        End If

        nbVal = i * bVal

        If i * bVal > 255 Then

            nbVal = 255

        End If

        '값을 실제로 부여함.

        Cells(i + 1, 4) = nrVal & ", " & ngVal & ", " & nbVal

        Cells(i + 1, 5).Interior.Color = RGB(nrVal, ngVal, nbVal)

        '조건이 맞으면 작업 중지

        If (nrVal = 255 And ngVal = 255 And nbVal = 255) Then

            i = 256

        Else

            i = i + 1

        End If

    Loop

    Cells(5, 4).Select

    ActiveWindow.FreezePanes = True

End Sub