[정규식] 텍스트 파일을 조건에 맞게 쪼개서 가져오기

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 String) As 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
 

통합 문서1.xlsm

text.txt