2013. 12. 23. 11:16

다수의 엑셀파일에서 특정 단어 추출하는 매크로

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.






Sub getFolder()



    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

   

    Dim fdFolder As FileDialog

    Dim lngCount As Long

   

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

    Sheets("fileSheet").Activate

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

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

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

   
    Cells(1, 1) = "단어:"
    Cells(1, 3) = "을"
    Cells(1, 5) = "행"
    Cells(1, 7) = "열부터"
    Cells(1, 10) = "행"
    Cells(1, 12) = "열까지에서 찾기"
   
   
    Range("B1,D1,F1,I1,K1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Cells(8, 5) = "*.xls*"

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

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

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

        If .Show = -1 Then

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

            folderspec = Range("D8").Value

            SearchSubFolders2

        End If

    End With

    Cells(8, 6) = "=counta(C9:C2000)"

End Sub

 


Sub extractWord()
'
   
    '변수 선언 integer 는 32767 까지의 값만을 지원한다.
    Dim i As Integer
    Dim maxVal As Integer
    Dim startVal As Integer
    Dim nextVal As Integer

    Dim fileCnt As Integer           ' 파일의 수
    Dim sheetCnt As Integer     ' 파일의 시트 수
    Dim sNo As Integer          ' 처리한 시트 수
    Dim cellPnt As Integer
    Dim rowCnt As Integer
    Dim colCnt As Integer
   
    Dim f_name As String        '읽고자 하는 파일명
    Dim t_name As String        '매핑정의서에 기재된 소스테이블명
    Dim file_name As String      '파일명 전체
    Dim targetWord As String   '찾고자하는 단어명
    Dim cellVal As String       '단어를 찾은 셀의 내용
   
    '변수 기본값 할당
    i = 9           ' 첫 파일명이 세번째 줄에 있음.
    cellPnt = 2     ' 두번째 줄부터 써야 함.
    maxVal = 0      '   초기화
    startVal = 1    ' 파일 찾기 시작
    nextVal = 0     '   초기화
   
    '처리할 파일의 갯수\
    orgWorkBookName = ActiveWorkbook.Name
   
    fileCnt = Cells(8, 6).Value
    targetWord = Sheets("fileSheet").Cells(1, 2).Value
    srVal = Sheets("fileSheet").Cells(1, 4).Value
    scVal = Sheets("fileSheet").Cells(1, 6).Value
    erVal = Sheets("fileSheet").Cells(1, 9).Value
    ecVal = Sheets("fileSheet").Cells(1, 11).Value
       
    ' 현재 있는 데이터를 모두 삭제해야 함.
   
    Sheets.Add after:=Sheets(1)
    Sheets(2).Name = "단어추출-" & Date & Hour(Time) & Minute(Time) & Second(Time)
   
    Sheets(2).Activate
    Cells(1, 1).Value = "번호"
    Cells(1, 2).Value = "폴더명"
    Columns("b:b").ColumnWidth = 20
'    Rows("8:8").RowHeight = 35.25
    Cells(1, 3).Value = "파일명"
    Columns("c:c").ColumnWidth = 40
    Cells(1, 4).Value = "시트명"
    Columns("d:d").ColumnWidth = 20
    Cells(1, 5).Value = "셀위치"
    Cells(1, 6).Value = "조회결과"
    Columns("f:f").ColumnWidth = 20
    Range(Cells(1, 1), Cells(1, 7)).Select
    Selection.AutoFilter
   
    '반복하며 파일 처리 함
    Do While i < fileCnt + 9

        sNo = 1

'        ' 파일열기
        d_name = Sheets("fileSheet").Cells(i, 2).Value
        f_name = Sheets("fileSheet").Cells(i, 3).Value
        file_name = d_name + "\" + f_name
   
        Dim fs, f, s
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.GetFile(file_name)
       
            Workbooks.Open Filename:=file_name
           
           
            sheetCnt = ActiveWorkbook.Sheets.Count
           
   
    '        '시트 수 만큼 반복하며 확인할 것
           
            Do While sNo <= sheetCnt
              
                Workbooks(f_name).Activate
                If Sheets(sNo).Visible = False Then
                Else
                    Sheets(sNo).Select
                    sName = Sheets(sNo).Name
                   
                    With Worksheets(sNo).Range(Cells(srVal, scVal), Cells(erVal, ecVal))
                        Set c = .Find(targetWord, LookIn:=xlValues)
                        If Not c Is Nothing Then
                            firstAddress = c.Address
                            Do
                                cellVal = c.Value
                                '확인된 시트명을 결과시트에 적기
                                Workbooks(orgWorkBookName).Activate
                                Sheets(2).Activate
                                ActiveSheet.Cells(cellPnt, 2).Select
                                ActiveSheet.Cells(cellPnt, 1).Value = Str(i - 8) + "/" + Str(fileCnt)
                                ActiveSheet.Cells(cellPnt, 2).Value = d_name
                                ActiveSheet.Cells(cellPnt, 3).Value = f_name
                                ActiveSheet.Cells(cellPnt, 4).Value = sName
                                anchorinfo = file_name + "#" + sName + "!" + c.Address
                               
                                ActiveSheet.Hyperlinks.Add anchor:=Cells(cellPnt, 5), Address:=anchorinfo, TextToDisplay:=c.Address
                               
                                ActiveSheet.Cells(cellPnt, 6).Value = cellVal
                               
                                cellPnt = cellPnt + 1
                               
                                Set c = .FindNext(c)
                                If c Is Nothing Then
                                    Exit Do
                                End If
                               
                            Loop While Not c Is Nothing And c.Address <> firstAddress
                      
                        Else
                            '확인된 시트명을 결과시트에 적기
                            Workbooks("감리자동화도구-단어추출.xls").Activate
                            Sheets(2).Activate
    '                        ActiveSheet.Cells(cellPnt, 2).Select
                            ActiveSheet.Cells(cellPnt, 1).Value = Str(i - 8) + "/" + Str(fileCnt)
                            ActiveSheet.Cells(cellPnt, 2).Value = d_name
                            ActiveSheet.Cells(cellPnt, 3).Value = f_name
                            ActiveSheet.Cells(cellPnt, 4).Value = sName
                            ActiveSheet.Cells(cellPnt, 5).Value = "없음"
                            ActiveSheet.Cells(cellPnt, 6).Value = "없음"
                            cellPnt = cellPnt + 1
                        End If
                    End With
                End If
                Cells(cellPnt, 1).Select
                sNo = sNo + 1
            Loop
        
            '파일 닫기
            Application.DisplayAlerts = False
            Workbooks(f_name).Close SaveChanges:=False
           
         i = i + 1
           
    Loop
    Range("a1:k1000").Select
    With Selection.Font
        .Name = "맑은 고딕"
        .Size = 10
    End With
   
    MsgBox ("작업을 완료하였습니다.")
   
End Sub
 

Sub SearchSubFolders2()
    Dim result As String
    Dim strFilter As String
    Dim Msg As String
    Dim strDir As String
    Dim r As Long
   
    strDir = Range("D8").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("E8").Value
   
    result = sRetrieve(strDir, strFilter, r)
  
End Sub

Private Function sRetrieve(sPath As String, strFilter As String, r As LoadPictureConstants) As String
  
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dDirs = fs.getFolder(sPath)
  
    For Each dDir In dDirs.SubFolders
        sRetrieve = sRetrieve(dDir.Path, strFilter, r) ' Here is the recursion
    Next
  
    For Each fFile In dDirs.Files
        If fFile.Name Like "~*" Then
        ElseIf 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


Sub 매크로1()
'
' 매크로1 매크로
'

'

End Sub
Sub 매크로2()
'
' 매크로2 매크로
'

'

End Sub

'MACRO > EXCEL-MACRO' 카테고리의 다른 글

추세분석 매크로  (0) 2013.12.27
엑셀에서 단어 추출하는 매크로  (0) 2013.12.27
파일 리스트 조회하기  (0) 2013.12.23
엑셀에서 하이퍼링크 걸기  (0) 2013.11.08
텍스트 자르기  (0) 2013.11.07
2013. 12. 23. 10:56

파일 리스트 조회하기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.


Sub getFolder()

       

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45

        

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30

    

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    Range("c3").Select

    Selection.ClearContents

    

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

        

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"




    '각종 변수 선언

    Dim strPath As String

    Dim strNm As String

    Dim i As Integer

    

    Dim fdFolder As FileDialog

    Dim lngCount As Long

    

    

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

    Sheets("fileSheet").Activate

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

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

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

    

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

    Set fdFolder = Application.FileDialog(msoFileDialogFolderPicker)

    With fdFolder

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

        If .Show = -1 Then

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

            folderspec = Range("c3").Value

        

        End If

    End With

    

End Sub


Sub getSubFolderInHere()

        

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45


        

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30


    

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    

    

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

        

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"



    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    

    strDir = Range("c3").Value

    strFileType = Range("c4").Value

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

    

    If strDir = "" Then

        getFolder

        Exit Sub

    ElseIf strFileType = "" Then

        strFileType = "*"

    End If

        

    r = 9

    

    

    Sheets(1).Cells(7, 1) = "검색폴더"

    Sheets(1).Cells(7, 2) = strDir

    Sheets(1).Cells(8, 1) = "검색단어"

    Sheets(1).Cells(8, 2) = strFileType

    Sheets(1).Cells(r, 1) = "번호"

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

    Sheets(1).Cells(r, 2).ColumnWidth = 45

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

    Sheets(1).Cells(r, 3).ColumnWidth = 45

    Sheets(1).Cells(r, 4) = "크기"

    Sheets(1).Cells(r, 5) = "파일타입"

    Sheets(1).Cells(r, 6) = "작성일"

    Sheets(1).Cells(r, 7) = "수정일"

    

    Sheets(1).Range(Cells(r, 1), Cells(r, 6)).Select

    Selection.AutoFilter

    

    Cells(10, 2).Select

    ActiveWindow.FreezePanes = True

        

    Sheets(1).Range("a10", "g1000").Select

    Selection.ClearContents

    

    r = r + 1

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

    

    strFilter = "*" & Sheets(1).Range("c4").Value & "*"

    

    result = sRetrieveInHere(strDir, strFilter, r)

    

    Sheets(1).Range("a1:g1000").Font.Name = "Arial"

    Sheets(1).Range("a1:g1000").Font.Size = 9

    Sheets(1).Range(Cells(4, 2), Cells(r, 2)).Select

    

    Selection.Replace What:=Cells(1, 2), Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

     

    Selection.Font.Underline = xlUnderlineStyleNone

    

    Sheets(1).Cells(4, 2).Select

End Sub



Sub getSubFolderInNext()

        

    Rows("1:2").Select

    Selection.RowHeight = 16.5

    

    Columns("a:a").ColumnWidth = 9

    Columns("B:B").ColumnWidth = 45


        

    ActiveSheet.Shapes("Button 2").Left = 10

    ActiveSheet.Shapes("Button 2").Top = 32

    ActiveSheet.Shapes("Button 2").Width = 300

    ActiveSheet.Shapes("Button 2").Height = 17

    

    ActiveSheet.Shapes("Button 1").Left = 10

    ActiveSheet.Shapes("Button 1").Top = 50

    ActiveSheet.Shapes("Button 1").Width = 150

    ActiveSheet.Shapes("Button 1").Height = 30

    

    ActiveSheet.Shapes("Button 3").Left = 160

    ActiveSheet.Shapes("Button 3").Top = 50

    ActiveSheet.Shapes("Button 3").Width = 150

    ActiveSheet.Shapes("Button 3").Height = 30

    

'필터와 디렉토리 내용 지우기

    Range("C1:C8").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    Selection.Borders(xlEdgeBottom).LineStyle = xlNone

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    

    

'필터와 디렉토리 새로 그리기

    Range("C3:C4").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 65535

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

        

Cells(1, 1) = "제작자"

Cells(1, 2) = "kca박규효"



    Dim result As String

    Dim strFilter As String

    Dim Msg As String

    Dim strDir As String

    Dim r As Long

    

    strDir = Range("c3").Value

    strFileType = Range("c4").Value

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

    

    If strDir = "" Then

        getFolder

        Exit Sub

    ElseIf strFileType = "" Then

        strFileType = "*"

    End If

        

    r = 3

    

    Sheets.Add after:=Sheets(1)

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

    

    

    Sheets(2).Cells(7, 1) = "검색폴더"

    Sheets(2).Cells(7, 2) = strDir

    Sheets(2).Cells(8, 1) = "검색단어"

    Sheets(2).Cells(8, 2) = strFileType

    Sheets(2).Cells(r, 1) = "번호"

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

    Sheets(2).Cells(r, 2).ColumnWidth = 45

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

    Sheets(2).Cells(r, 3).ColumnWidth = 45

    Sheets(2).Cells(r, 4) = "크기"

    Sheets(2).Cells(r, 5) = "파일타입"

    Sheets(2).Cells(r, 6) = "작성일"

    Sheets(2).Cells(r, 7) = "수정일"

    

    Sheets(2).Range(Cells(r, 1), Cells(r, 6)).Select

    Selection.AutoFilter

    

    Cells(4, 2).Select

    ActiveWindow.FreezePanes = True

        

    Sheets(2).Range("a4", "g1000").Select

    Selection.ClearContents

    

    r = r + 1

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

    

    strFilter = "*" & Sheets(1).Range("c4").Value & "*"

    

    result = sRetrieveInNext(strDir, strFilter, r)

    

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

    Sheets(2).Range("a1:g1000").Font.Size = 9

    Sheets(2).Range(Cells(4, 2), Cells(r, 2)).Select

    

    Selection.Replace What:=Cells(1, 2), Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

     

    Sheets(2).Cells(4, 2).Select

End Sub



Private Function sRetrieveInNext(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

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

    Next

    

    For Each fFile In dDirs.Files

        If fFile.Name Like "~*" Then

        ElseIf fFile.Name Like strFilter Then

            

            Sheets(2).Cells(r, 1) = r - 3

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


            anchorinfo = fFile.parentfolder.Path + "\" + fFile.Name

             

            ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 3), Address:=anchorinfo, TextToDisplay:=fFile.Name

            Sheets(2).Cells(r, 4) = fFile.Size

            Sheets(2).Cells(r, 5) = fFile.Type

            Sheets(2).Cells(r, 6) = Left(fFile.datecreated, 10)

            Sheets(2).Cells(r, 7) = Left(fFile.DateLastModified, 10)

            

                     

           r = r + 1

        End If

    Next

    

    Set fs = Nothing

    

End Function


 


Private Function sRetrieveInHere(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

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

    Next

    

    For Each fFile In dDirs.Files

        

        If fFile.Name Like "~*" Then

        ElseIf fFile.Name Like strFilter Then

            

            Sheets(1).Cells(r, 1) = r - 9

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


            anchorinfo = fFile.parentfolder.Path + "\" + fFile.Name

             

            ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 3), Address:=anchorinfo, TextToDisplay:=fFile.Name

            

            Sheets(1).Cells(r, 4) = fFile.Size

            Sheets(1).Cells(r, 5) = fFile.Type

            Sheets(1).Cells(r, 6) = Left(fFile.datecreated, 10)

            Sheets(1).Cells(r, 7) = Left(fFile.DateLastModified, 10)

            

                     

           r = r + 1

        End If

    Next

    

    Set fs = Nothing

    

End Function


 



2013. 11. 8. 10:09

엑셀에서 하이퍼링크 걸기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.

특별한 것은 없는데 중간에 하이퍼링크 거는 방법을 참고하시라고 올려봅니다.


Sub extractWord()

'

' Macro1 Macro

'


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

    Dim i As Integer

    Dim maxVal As Integer

    Dim startVal As Integer

    Dim nextVal As Integer


    Dim fileCnt As Integer           ' 파일의 수

    Dim sheetCnt As Integer     ' 파일의 시트 수

    Dim sNo As Integer          ' 처리한 시트 수

    Dim cellPnt As Integer

    Dim rowCnt As Integer

    Dim colCnt As Integer

    

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

    Dim t_name As String        '매핑정의서에 기재된 소스테이블명

    Dim file_name As String      '파일명 전체

    Dim targetWord As String   '찾고자하는 단어명

    Dim cellVal As String       '단어를 찾은 셀의 내용

    

    '변수 기본값 할당

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

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

    maxVal = 0      '   초기화

    startVal = 1    ' 파일 찾기 시작

    nextVal = 0     '   초기화

    

    '처리할 시트의 위치

    startSht = Cells(1, 2).Value

    jobName = Cells(2, 2).Value

    sColVal = Cells(1, 4).Value

    sRowVal = Cells(1, 6).Value

    eColVal = Cells(2, 4).Value

    eRowVal = Cells(2, 6).Value

    titleVal = Cells(2, 10).Value

    

    ' 시트를 새로 만든다.

    orgBookName = ActiveWorkbook.Name

    

    Sheets.Add after:=Sheets(1)

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

    

    Cells(1, 4).Activate

    ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C:R[3000]C)"

    

    '반복하며 파일 처리 함

        sNo = 1


        ' 파일열기

        d_name = Sheets("fileSheet").Cells(i, 2).Value

        f_name = Sheets("fileSheet").Cells(i, 3).Value

        

        file_name = d_name + f_name

    

        Dim fs, f, s

        Set fs = CreateObject("Scripting.FileSystemObject")

        Set f = fs.GetFile(file_name)

        

            Workbooks.Open Filename:=file_name

            

            sheetCnt = ActiveWorkbook.Sheets.Count

    

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

        

            

            Do While sNo <= sheetCnt

                If sNo < startSht Then

                Else

                    

                    Workbooks(f_name).Activate

                    If Sheets(sNo).Visible = xlSheetVisible Then

                        Sheets(sNo).Select

                        sName = Sheets(sNo).Name

                        

                        If sNo = startSht Then

                            Range(Cells(sColVal - titleVal, sRowVal), Cells(eColVal, eRowVal)).Select

                        Else

                            Range(Cells(sColVal, sRowVal), Cells(eColVal, eRowVal)).Select

                        End If

                        Selection.Copy

                        

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

                        

                        Workbooks(orgBookName).Activate

                        

                        If sNo = startSht Then

                            ActiveSheet.Cells(cellPnt + titleVal, 1).Value = sNo

                            anchorinfo = file_name + "#'" + sName + "'!A1"

                            ActiveSheet.Hyperlinks.Add Anchor:=Cells(cellPnt + titleVal, 3), Address:=anchorinfo, TextToDisplay:=sName

                        Else

                            ActiveSheet.Cells(cellPnt, 1).Value = sNo

                            anchorinfo = file_name + "#'" + sName + "'!A1"

                            ActiveSheet.Hyperlinks.Add Anchor:=Cells(cellPnt, 3), Address:=anchorinfo, TextToDisplay:=sName

                        End If

                        Cells(cellPnt, 4).Select

                        ActiveSheet.Paste

                                                

                        lastRow = Cells(1, 4).Value

                                        

                        If sNo = startSht Then

                            ActiveSheet.Cells(cellPnt + titleVal, 2).Value = lastRow - (titleVal)

                        

                            Range(Cells(cellPnt + titleVal, 1), Cells(cellPnt + titleVal, 3)).Copy

                            Range(Cells(cellPnt + titleVal + 1, 1), Cells(lastRow - cellPnt + 3, 3)).Select

                            ActiveSheet.Paste

                        

                        Else

                            pgmCnt = lastRow - cellPnt + 2

                            ActiveSheet.Cells(cellPnt, 2).Value = pgmCnt

                        

                            Range(Cells(cellPnt, 1), Cells(cellPnt, 3)).Copy

                            Range(Cells(cellPnt + 1, 1), Cells(cellPnt + pgmCnt - 1, 3)).Select

                            ActiveSheet.Paste

                        

                        

                        End If

                        

                        cellPnt = lastRow + 2

                           

                           

                           

                    End If

                End If

                sNo = sNo + 1

            Loop

         

            '파일 닫기

            Application.DisplayAlerts = False

            Workbooks(f_name).Close SaveChanges:=False

            

         i = i + 1

    

    Cells(titleVal + 1, 1).Value = "시트번호"

    Cells(titleVal + 1, 2).Value = "프로그램목록 수"

    Cells(titleVal + 1, 3).Value = "시트명"

    

    Rows("2:3000").Select

    Selection.RowHeight = 16.5

    

    Cells(titleVal + 2, 4).Select

    ActiveWindow.FreezePanes = True

    

    Sheets(2).Range(Cells(titleVal + 1, 1), Cells(titleVal + 1, 38)).Select

    Selection.AutoFilter

    

    Cells(1, 7).Select

                

'    ActiveWorkbook.SaveAs Filename:="c:\temp\test.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    ActiveWorkbook.Save

                

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

    

End Sub



'MACRO > EXCEL-MACRO' 카테고리의 다른 글

다수의 엑셀파일에서 특정 단어 추출하는 매크로  (0) 2013.12.23
파일 리스트 조회하기  (0) 2013.12.23
텍스트 자르기  (0) 2013.11.07
autofilter 확인하기  (0) 2013.10.31
매크로 위 아래 줄 비교 하기  (0) 2013.06.17
2013. 11. 7. 16:21

텍스트 자르기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.

외부에서 하나의 텍스트 파일로 제공된 파일을 정해진 크기에 맞춰 자르는 매크로 소스입니다. 

파일이 없으면 확인하기도 어렵겠지만 처리하는 방식을 참조하시기 바랍니다. 

첫번 째 시트에 텍스트 파일을 옮겨놓습니다. 텍스트파일은 sam파일이나 cdr 데이터 등 일겁니다.

두번째 시트에 작업을합니다. 


시작은 두번째 시트에서 시작합니다. 



Sub chopText()

    

    Cells(4, 3).Select

    ActiveCell.FormulaR1C1 = "=COUNTA(R[3]C:R[300]C)"

    colCnt = Cells(4, 3)

    

    

    '테이블 정의 읽어오기

    Range(Cells(6, 3), Cells(colCnt + 6, 3)).Select

    Selection.Copy

    Cells(3, 12).Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    Range(Cells(6, 6), Cells(colCnt + 6, 8)).Select

    Selection.Copy

    Cells(4, 12).Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    

    '컨텐츠 복사해 오기

    Sheets("데이터").Select

    Range(Cells(1, 1), Cells(100000, 10)).Select

    Selection.Copy

    

    Sheets("수행").Select

    Cells(7, 13).Select

    ActiveSheet.Paste

    

    Cells(2, 12).Select

    ActiveCell.FormulaR1C1 = "=COUNTA(R[5]C:R[100000]C)"

    txtCnt = Cells(2, 12)

    

    '7번에 있는 레코드는 헤더

    t = 8

    Do While t < txtCnt + 6

        chopTxt = Cells(t, 12)

            i = 13

            Do While i < colCnt + 14

                chopLen = Cells(5, i)

                Cells(t, i + 1).Select

                Selection.NumberFormatLocal = "@"

                Cells(t, i + 1) = Mid(Cells(t, i), chopLen + 1)

                

                Cells(t, i).Select

                Selection.NumberFormatLocal = "@"

                Cells(t, i) = Mid(Cells(t, i), 1, chopLen)

                i = i + 1

            Loop

        

        

        t = t + 1

    Loop

    

 Cells(6, 12).Select

End Sub


Sub clearPage()


    Range(Cells(7, 1), Cells(300, 10)).Clear

    

    Range(Cells(1, 11), Cells(1000, 400)).Clear

    


End Sub


'MACRO > EXCEL-MACRO' 카테고리의 다른 글

파일 리스트 조회하기  (0) 2013.12.23
엑셀에서 하이퍼링크 걸기  (0) 2013.11.08
autofilter 확인하기  (0) 2013.10.31
매크로 위 아래 줄 비교 하기  (0) 2013.06.17
함수 2. count 함수 사용  (0) 2013.06.13
2013. 10. 31. 15:14

autofilter 확인하기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.

엑셀 매크로를 작성하는 동안 상당히 거슬렸던 것이 autofilter다.


selection.autofilter라고하면 자동으로 필터가 걸리기 때문에 설정도 쉽고

기왕에 설정된 시트에 selection.autofilter를 실행하면 자동으로 해제되기 때문에 해제도 쉽다.

그러나 있으면 없애고 없으면 생기게 하기가 쉽지 않았다. 


 autofilter는 셀 단위로 걸리는데 필터의 설정 여부를 확인하는 것은 시트 단위이다.

따라서 시트의 autofiltermode를 점검해서 true면 넘어가고 false면 설정하면 된다. 


        ' 시트에 자동 필터가 설정되어 있는지 확인한다. 

        afChk = Worksheets("컬럼비교").AutoFilterMode

        

' 만약 설정되어 있으면

        If afChk = True Then

' 내가 원하는 필터가 아닐 수 있으므로 해제하고 내가 원하는 필터로 교체한다. 

            afChk = Selection.AutoFilter

            Range("A3:K3").Select

            afChk = Selection.AutoFilter

        Else

' 내가 원하는 필터를 설정한다. 

            Range("A3:K3").Select

            afChk = Selection.AutoFilter

        End If

            


2013. 6. 17. 15:17

매크로 위 아래 줄 비교 하기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.

회사와 직급, 이름을 기준으로 한 회사에 두명 이상이 등록되어 있으면 검토하는 매크로입니다.

수작업을 거쳐야 하는데 필터를 이름->직급->회사 순으로 내림차순 정렬하셔야 합니다. 

이렇게 하면 회사 기준 -> 직급 -> 이름으로 정렬됩니다.  

나머지는 실제 실행하면서 확인하시길 바랍니다. 


row-delete.xlsm




'컬럼을 비교해서 삭제하는 부분입니다. 

Sub chkColumnsNext()


    Range(Cells(7, 14), Cells(100, 15)).Delete

       


    Sheets(1).Select

    Cells(2, 2).Select

    ActiveCell.FormulaR1C1 = "=COUNTA(R[5]C[4]:R[10000]C[4])"

    sameRowCnt = 1

    colCnt = Cells(2, 2)

    

    i = 7

    Do While i < colCnt + 7

        Cells(2, 4) = i

        Cells(i, 2).Select

        

        stdColName = Cells(i, 2)

        stdColType = Cells(i, 3)

        stdColLen = Cells(i, 4)

     

        cmpColName = Cells(i + 1, 2)

        cmpColType = Cells(i + 1, 3)

        cmpColLen = Cells(i + 1, 4)

    

        '이름이 같으면 타입을 비교함.

        If stdColName = "신원제품" Then

            aaa = bbb

        End If

        If stdColName = cmpColName Then

            sameRowCnt = sameRowCnt + 1

            If stdColType = cmpColType And stdColLen = cmpColLen Then

                Cells(i + 1, 2).Select

                Selection.EntireRow.Delete

            ElseIf stdColType <> cmpColType And stdColLen = cmpColLen Then

                Cells(i + 1, 14).Interior.Color = RGB(255, 100, 100)

                Cells(i + 1, 14) = "직급 상이함"

                i = i + 1

            ElseIf stdColType = cmpColType And stdColLen <> cmpColLen Then

                Cells(i + 1, 15).Interior.Color = RGB(255, 100, 100)

                Cells(i + 1, 15) = "이름 상이함"

                i = i + 1

            ElseIf stdColType <> cmpColType And stdColLen <> cmpColLen Then

                Cells(i + 1, 14).Interior.Color = RGB(255, 100, 100)

                Cells(i + 1, 14) = "직급 상이함"

                Cells(i + 1, 15).Interior.Color = RGB(255, 100, 100)

                Cells(i + 1, 15) = "이름 상이함"

                i = i + 1

            End If

        '이름이 다르면 그냥 넘어감

        Else

            If sameRowCnt = 1 Then

            '    Selection.EntireRow.Delete

                Cells(i, 2).Interior.Color = RGB(100, 255, 100)

                Cells(i, 14) = "적합"

'                Cells(i + 1, 15) = "이름 상이함"

            End If

                i = i + 1

            sameRowCnt = 1

        End If

        colCnt = Cells(2, 2)

    Loop

    

 

End Sub


'정렬하는 부분입니다.

Sub setSort()

'

' setSort 매크로

'

    '갯수를 센다

    Range("B5").Select

    ActiveCell.FormulaR1C1 = "=COUNTA(R[2]C:R[94]C)"



    Cells(8, 1) = 1

    Cells(9, 1) = 2

    Range("A8:A9").Select

    Selection.AutoFill Destination:=Range("A8:A81")

    Cells(8, 1).Select


    '정렬 하기

    Range("A6:M6").Select

            

    

    afCheck = Selection.AutoFilter


    If afCheck = True Then

    Else

        ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Range _

            ("B6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

            xlSortNormal

        With ActiveWorkbook.Worksheets(1).AutoFilter.Sort

            .Header = xlYes

            .MatchCase = False

            .Orientation = xlTopToBottom

            .SortMethod = xlPinYin

            .Apply

        End With

    End If

End Sub

 


2013. 6. 13. 20:20

함수 2. count 함수 사용

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.
COUNT 인수 목록에서 숫자의 개수를 반환합니다.
COUNTA 인수 목록에서 값의 개수를 반환합니다.
COUNTBLANK 범위 내에서 비어 있는 셀의 개수를 반환합니다.
COUNTIF 범위 내에서 주어진 조건을 만족하는 셀의 개수를 반환합니다.
COUNTIFS 범위 내에서 여러 조건을 만족하는 셀의 개수를 반환합니다.

count 함수는 다양하게 있지만 이 중 흔히 사용하는 함수는 count와 counta입니다. 
count의 경우 숫자만을 세는 함수입니다. 
그러나 아래와 같이 조건을 넣을 경우 문자도 셀 수 있으며, 
하나의 함수에 몇개의 조건을 넣을 수가 있습니다. 
'=COUNT(B6:B19,"해당없음",C6:C19,"변동")

counta()의 경우 숫자와 숫자가 이닌 것 모두 셉니다. 
따라서 값이 있는 필드의 갯수를 구할 때 요긴합니다. 




countif()는 조건에 맞는 값만을 계산할 때 사용합니다. 

'=COUNTIF(D6:D19,"<100")


비숫한 countifs()는 다양한 조건을 사용할 수 있다는 면에서 편리한 함수입니다. 

'=COUNTIFS(C6:C19,"변동",D6:D19,">50",E6:E19,"<10000000000")





2013. 6. 12. 22:52

함수 사용 1, if함수와 isna, 그리고 vlookup 사용하기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.

어떤 특정한 값을 목록과 비교할 때 주로 사용하는것이 vlookup함수입니다. 


그런데 vlookup 함수를 사용할 경우 #N/A 가 자주 나타납니다. 


이것은 찾고자 하는 단어가 목록에 없기 때문에 나타나는 것입니다. 


즉 아래와 같이 함수를 사용했는데 


=VLOOKUP(B4,$F$4:$G$51,2,FALSE)


B4에 해당하는 값이 목록에 없으면 아래의 그림처럼 #N/A가 출력됩니다. 



#N/A는 다루기도 불편하고 보기도 좋지 않지요. 


차라리 ISNA함수를 사용하여 아래와 같이 변경하면 보기 좋은 결과가 나타납니다. 

ISNA()는 ()안의 값이 #N/A 인지 물어보는 것입니다. 

만약 #N/A이면 true를 아니면 false를 리턴합니다. 

따라서 if문을 사용하여 아래와 같이 물어보면 보다 보기 좋은 데이터가 출력됩니다. 


=IF(ISNA(VLOOKUP(B4,$F$4:$G$51,2,FALSE))=TRUE,"해당없음",VLOOKUP(B4,$F$4:$G$51,2,FALSE))



vlookup은 가장 자주 사용하는 함수라서 먼저 등록합니다. 


2013. 5. 14. 11:28

작업 결과를 백업파일에 자동 저장하기

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.

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

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

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




    ' 시트를 새로 만든다.

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

    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


2013. 4. 19. 20:30

매크로와 함수 비교

336x280(권장), 300x250(권장), 250x250, 200x200 크기의 광고 코드만 넣을 수 있습니다.


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

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


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


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



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


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