'MACRO/EXCEL-MACRO'에 해당되는 글 34건
- 2013.12.23 다수의 엑셀파일에서 특정 단어 추출하는 매크로
- 2013.12.23 파일 리스트 조회하기
- 2013.11.08 엑셀에서 하이퍼링크 걸기
- 2013.11.07 텍스트 자르기
- 2013.10.31 autofilter 확인하기
- 2013.06.17 매크로 위 아래 줄 비교 하기
- 2013.06.13 함수 2. count 함수 사용
- 2013.06.12 함수 사용 1, if함수와 isna, 그리고 vlookup 사용하기
- 2013.05.14 작업 결과를 백업파일에 자동 저장하기
- 2013.04.19 매크로와 함수 비교
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 |
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
'MACRO > EXCEL-MACRO' 카테고리의 다른 글
엑셀에서 단어 추출하는 매크로 (0) | 2013.12.27 |
---|---|
다수의 엑셀파일에서 특정 단어 추출하는 매크로 (0) | 2013.12.23 |
엑셀에서 하이퍼링크 걸기 (0) | 2013.11.08 |
텍스트 자르기 (0) | 2013.11.07 |
autofilter 확인하기 (0) | 2013.10.31 |
특별한 것은 없는데 중간에 하이퍼링크 거는 방법을 참고하시라고 올려봅니다.
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 |
외부에서 하나의 텍스트 파일로 제공된 파일을 정해진 크기에 맞춰 자르는 매크로 소스입니다.
파일이 없으면 확인하기도 어렵겠지만 처리하는 방식을 참조하시기 바랍니다.
첫번 째 시트에 텍스트 파일을 옮겨놓습니다. 텍스트파일은 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 |
엑셀 매크로를 작성하는 동안 상당히 거슬렸던 것이 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
'MACRO > EXCEL-MACRO' 카테고리의 다른 글
엑셀에서 하이퍼링크 걸기 (0) | 2013.11.08 |
---|---|
텍스트 자르기 (0) | 2013.11.07 |
매크로 위 아래 줄 비교 하기 (0) | 2013.06.17 |
함수 2. count 함수 사용 (0) | 2013.06.13 |
함수 사용 1, if함수와 isna, 그리고 vlookup 사용하기 (0) | 2013.06.12 |
회사와 직급, 이름을 기준으로 한 회사에 두명 이상이 등록되어 있으면 검토하는 매크로입니다.
수작업을 거쳐야 하는데 필터를 이름->직급->회사 순으로 내림차순 정렬하셔야 합니다.
이렇게 하면 회사 기준 -> 직급 -> 이름으로 정렬됩니다.
나머지는 실제 실행하면서 확인하시길 바랍니다.
'컬럼을 비교해서 삭제하는 부분입니다.
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
'MACRO > EXCEL-MACRO' 카테고리의 다른 글
텍스트 자르기 (0) | 2013.11.07 |
---|---|
autofilter 확인하기 (0) | 2013.10.31 |
함수 2. count 함수 사용 (0) | 2013.06.13 |
함수 사용 1, if함수와 isna, 그리고 vlookup 사용하기 (0) | 2013.06.12 |
작업 결과를 백업파일에 자동 저장하기 (0) | 2013.05.14 |
countif()는 조건에 맞는 값만을 계산할 때 사용합니다.
'=COUNTIF(D6:D19,"<100")
비숫한 countifs()는 다양한 조건을 사용할 수 있다는 면에서 편리한 함수입니다.
'=COUNTIFS(C6:C19,"변동",D6:D19,">50",E6:E19,"<10000000000")
'MACRO > EXCEL-MACRO' 카테고리의 다른 글
autofilter 확인하기 (0) | 2013.10.31 |
---|---|
매크로 위 아래 줄 비교 하기 (0) | 2013.06.17 |
함수 사용 1, if함수와 isna, 그리고 vlookup 사용하기 (0) | 2013.06.12 |
작업 결과를 백업파일에 자동 저장하기 (0) | 2013.05.14 |
매크로와 함수 비교 (0) | 2013.04.19 |
어떤 특정한 값을 목록과 비교할 때 주로 사용하는것이 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은 가장 자주 사용하는 함수라서 먼저 등록합니다.
'MACRO > EXCEL-MACRO' 카테고리의 다른 글
매크로 위 아래 줄 비교 하기 (0) | 2013.06.17 |
---|---|
함수 2. count 함수 사용 (0) | 2013.06.13 |
작업 결과를 백업파일에 자동 저장하기 (0) | 2013.05.14 |
매크로와 함수 비교 (0) | 2013.04.19 |
세금 계산 하는 로직입니다. (0) | 2013.04.19 |
엑셀로 데이터를 처리한 후 이를 특정파일에 일일이 저장하는 것은 생각보다 번거로운 일입니다.
가끔 잊어버리는 경우 백업본이 생성되지 않아 작업결과를 잃어버리기도 하지요.
아래 코드는 자료 처리를 완료한 후 새로운 엑셀 파일을 만들거나 기존 파일에 작업결과를 저장하는 코드입니다.
' 시트를 새로 만든다.
' 현재 작업 파일 정보를 저장한다.
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
'MACRO > EXCEL-MACRO' 카테고리의 다른 글
함수 2. count 함수 사용 (0) | 2013.06.13 |
---|---|
함수 사용 1, if함수와 isna, 그리고 vlookup 사용하기 (0) | 2013.06.12 |
매크로와 함수 비교 (0) | 2013.04.19 |
세금 계산 하는 로직입니다. (0) | 2013.04.19 |
엑셀매크로] 리스트의 파일을 열어서 시트명과 셀값을 복사해오기 (0) | 2013.01.22 |
해외 쇼핑몰에서 물건을 사올 때 비용계산하는 엑셀입니다.
엑셀의 함수를 사용해서 만들었는데 오늘 마침 시간도 있고 해서 매크로로 변경했습니다.
둘 다 올려놨으니 비교해보세요.
똑같은 기능은 아닙니다. 다만 함수를 사용하는 것과 다르다는 것을 참조하라는 겁니다.
'MACRO > EXCEL-MACRO' 카테고리의 다른 글
함수 사용 1, if함수와 isna, 그리고 vlookup 사용하기 (0) | 2013.06.12 |
---|---|
작업 결과를 백업파일에 자동 저장하기 (0) | 2013.05.14 |
세금 계산 하는 로직입니다. (0) | 2013.04.19 |
엑셀매크로] 리스트의 파일을 열어서 시트명과 셀값을 복사해오기 (0) | 2013.01.22 |
EXCEL MACRO-엑셀에서 파일리스트 보기 (0) | 2013.01.21 |