VB(A)

폴더 선택하여 텍스트파일 한줄로 가져오기

당근쨈 2015. 2. 25. 21:54

폴더를 선택하면 폴더 안에 있는 텍스트 파일을 모조리 불러오는 방식이다.

배열을 이용하여 속도향상에 중점을 두었다.

파일을 많이 불러올 수록 효과가 있는 코드.

이로서 밀린 매크로 작업 완료.


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



(배열) 텍스트파일 가져오기.xlsm


1234.txt








'VB(A)' 카테고리의 다른 글

부부직원이면 빨간색으로 표시하기  (0) 2015.03.01
VBA 첫 알바  (0) 2015.03.01
일부 시트들을 새 파일로 저장  (0) 2015.02.23
이름을 자음 모음으로 분리하기  (0) 2015.02.22
시트별로 파일 저장  (0) 2015.02.21