폴더를 선택하면 폴더 안에 있는 텍스트 파일을 모조리 불러오는 방식이다.
배열을 이용하여 속도향상에 중점을 두었다.
파일을 많이 불러올 수록 효과가 있는 코드.
이로서 밀린 매크로 작업 완료.
Option Explicit Sub impLongTxt() Dim rngImport As Range Dim strPath As String Dim fileName As Variant Dim i As Long, j As Integer Dim varTemp() As String '작업속도 상승 With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual '기존자료 삭제 With Sheets(2) .Select .UsedRange.Delete End With '엑셀파일의 위치와 동일한 경로설정 및 폴더 선택 j = 1 Set rngImport = Range("A1") ChDir ThisWorkbook.Path With .FileDialog(msoFileDialogFolderPicker) .Show '폴더 내 파일이 없으면 매크로 종료 If .SelectedItems.Count = 0 Then Exit Sub Else strPath = .SelectedItems(1) & "\" End If End With End With '설정한 폴더 안의 텍스트 파일을 모두 불러오고 파일이 없으면 매크로 종료 fileName = Dir(strPath & "*.txt") If fileName = "" Then MsgBox "폴더에 텍스트 파일이 없음." Exit Sub End If '폴더 내 텍스트 파일이 없을 때까지 불러오기 Do While fileName <> "" Open strPath & fileName For Input As #1 '텍스트 파일을 " " 기준으로 배열에 삽입 varTemp = Split(Input$(LOF(1), #1), " ") '배열을 각 셀에 입력 For i = 0 To UBound(varTemp) Cells(i + 1, j) = varTemp(i) Next i '변수 초기화 j = j + 1 Erase varTemp Close #1 fileName = Dir Loop '서식 지정 및 마무리 rngImport.CurrentRegion.NumberFormatLocal = "0.0_ " With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With MsgBox "작업을 완료하였습니다." End Sub | cs |
'VB(A)' 카테고리의 다른 글
부부직원이면 빨간색으로 표시하기 (0) | 2015.03.01 |
---|---|
VBA 첫 알바 (0) | 2015.03.01 |
일부 시트들을 새 파일로 저장 (0) | 2015.02.23 |
이름을 자음 모음으로 분리하기 (0) | 2015.02.22 |
시트별로 파일 저장 (0) | 2015.02.21 |