ABOUT ME

-

Today
-
Yesterday
-
Total
-
  • [정규식] 텍스트 파일을 조건에 맞게 쪼개서 가져오기
    VB(A) 2017.12.31 23:26

    http://cafe.naver.com/excelmaster/146535


    띄어쓰기 없이 한줄로 나열된 텍스트를 조건에 맞게 쪼개서 가져오는 패턴

    코드도 쓸데없이 많이 쪼갠 탓인지 길어졌군.

    매크로 파일과 텍스트 파일을 한 폴더에 두고 실행하면 됨


    Option Explicit
     
    Private Final() As Variant
    Private r As Integer
    Private c As Integer
    Sub Macro()
        
        Dim v() As String
        Dim MyTxtFile As String
     
        '텍스트 파일 불러오기
        Range("A1").CurrentRegion.Offset(1).ClearContents
        MyTxtFile = ThisWorkbook.Path & "\text.txt"
        
        v = OpenTxtFile(MyTxtFile)  '텍스트 파일을 불러와서 배열에 삽입하기
        Call SeperateText(v)    '조건에 맞게 배열을 쪼개기
        
        '셀에 출력
        Range("A2").Resize(r, c) = Final
        
        '변수 초기화­
        Erase Final
        r = 0: c = 0
        
    End Sub
     
    Function OpenTxtFile(TextFile As StringAs Variant
        '텍스트 파일을 배열에 삽입하기
     
        Dim TextArray As String
        Dim v() As String
        Dim i As Integer
        
        Open TextFile For Input As #1
        
        '텍스트 파일을 한줄씩 순환하며 배열에 삽입
        Do While Not EOF(1)
        
            Line Input #1, TextArray
            
            ReDim Preserve v(i)
            v(i) = TextArray
            i = i + 1
     
        Loop
        
        OpenTxtFile = v
        
        '변수 초기화
        Erase v
        TextArray = vbNullString
        Close #1
        
    End Function
     
    Sub SeperateText(tmp As Variant)
        '조건에 맞게 배열을 쪼개기
     
        Dim MySet As Object
        Dim SingleArray
        
        '셀 출력용 배열로 재선언
        ReDim Final(UBound(tmp), 3)
     
        '정규식을 선언하여 텍스트를 쪼갤 조건을 부여함
        With CreateObject("vbscript.regexp")
        
            .Global = True
            .Pattern = "([A-Z]+)([0-9,]+)\+?(-?\d+)\+?([-0-9.]+%)"  '종목 가격 증감 퍼센트
            
            For Each SingleArray In tmp
            
                If .test(SingleArray) = True Then
                
                    Set MySet = .Execute(SingleArray)
                  
                    For c = 0 To 3
                        Final(r, c) = MySet(0).submatches(c)
                    Next c
                    
                    r = r + 1
                
                End If
                
            Next SingleArray
            
        End With
     
    End Sub
     
    cs

    통합 문서1.xlsm

    text.txt


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

    도로명주소 가져오기  (0) 2018.02.13
    여러 시트를 쉽게 이동하기  (0) 2018.01.05
    [정규식] 텍스트 파일을 조건에 맞게 쪼개서 가져오기  (0) 2017.12.31
    웹페이지 파싱  (0) 2017.09.23
    [월보용] 데이터 합치기  (0) 2017.09.01
    월보 취합 서식  (0) 2017.08.29

    댓글 0