2017-04-11 4 views
0

나는 여전히 vba를 처음 사용하고 있으며 데이터 가져 오기와 관련하여 질문이 있습니다. 텍스트 파일에서 데이터를 가져오고 조 변경하려면 다음 코드를 (아래) 가지고 있지만 fx 다섯 개의 파일을 강조 표시 한 다음 가져올 수 있으면 좋을 것입니다. multiselect가 필요하지만 선택한 모든 파일을 실행하는 스크립트를 얻는 방법은 무엇입니까?여러 txt 파일에서 데이터를 가져 오는 방법

희망 하시겠습니까?

안부

로니

FILOPEN = Application.GetOpenFilename("Files (*.txt; *.jpg; *.bmp; 

*.tif),*.chr; *_chr.txt; *chr.txt; *.tif", _ 
, "Select Picture to Import") 
On Error GoTo LastLine 

Application.ScreenUpdating = False 
    Workbooks.OpenText Filename:=FILOPEN, _ 
    Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ 
     xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _ 
     Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
     TrailingMinusNumbers:=True 

'name of file that is imported from 
Dim z As String 

z = ActiveWorkbook.Name 
Windows(Left(z, Len(z))).Activate 

'Copy Data 
Range("c1").Select 

    Selection.End(xlDown).Select 
    ActiveCell.Offset(1, 0).Range("A1").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy 


Windows(Left(f, Len(f))).Activate 'name of file that is imported into (original sheet) 

    ActiveCell.Offset(0, 1).Range("A1").Select 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=True 

    Selection.End(xlToLeft).Select 
    ActiveCell.Offset(0, 0).Range("A1").Select 

답변

0

여러 파일을 선택하려면 Application.GetOpenFilename 방법에 MultiSelect:=True를 추가

If IsArray(FILOPEN) Then 
    For I = LBound(FILOPEN) To UBound(FILOPEN) 
     Workbooks.OpenText Filename:=FILOPEN(I) ... 
     ... 
     ... 
     ... 
    Next I 
End If 
:

FILOPEN = Application.GetOpenFilename(_ 
FileFilter:="Files (*.txt; *.jpg; *.bmp; *.tif), *.chr; *_chr.txt; *chr.txt; *.tif", _ 
Title:="Select Picture to Import", _ 
MultiSelect:=True) 

그런 다음 결과의 배열을 반복

+0

멋진 스크립트로 내 전체 스크립트를 감싸고 모든 것이 가져오고 처리됩니다. :) 감사합니다. – La82

0

아래 스크립트는 모든 텍스트 파일을 가져옵니다. 물론 Taosique와 같이 여러 개의 파일을 선택할 수 있습니다. 모든 파일을 가져 오려면 아래 코드를 실행하십시오.

Sub Import_All_Text_Files_2007() 

    Dim nxt_row As Long 

    'Change Path 
    Const strPath As String = "enter_your_path_here\" 
    Dim strExtension As String 

    'Stop Screen Flickering 
    Application.ScreenUpdating = False 

    ChDir strPath 

    'Change extension 
    strExtension = Dir(strPath & "*.txt") 

    Do While strExtension <> "" 

     'Adds File Name as title on next row 
     Range("A65536").End(xlUp).Offset(1, 0).Value = strExtension 

     'Sets Row Number for Data to Begin 
     nxt_row = Range("A65536").End(xlUp).Offset(1, 0).Row 

     'Below is from a recorded macro importing a text file 
     With ActiveSheet.QueryTables.Add(Connection:= _ 
      "TEXT;" & strPath & strExtension, Destination:=Range("$A$" & nxt_row)) 
      .Name = strExtension 
      .FieldNames = True 
      .RowNumbers = False 
      .FillAdjacentFormulas = False 
      .PreserveFormatting = True 
      .RefreshOnFileOpen = False 
      .RefreshStyle = xlInsertDeleteCells 
      .SavePassword = False 
      .SaveData = True 
      .AdjustColumnWidth = True 
      .RefreshPeriod = 0 
      .TextFilePromptOnRefresh = False 
      .TextFilePlatform = 850 
      .TextFileStartRow = 1 
      .TextFileParseType = xlDelimited 
      .TextFileTextQualifier = xlTextQualifierDoubleQuote 
      'Delimiter Settings: 
      .TextFileConsecutiveDelimiter = True 
      .TextFileTabDelimiter = True 
      .TextFileSemicolonDelimiter = True 
      .TextFileCommaDelimiter = True 
      .TextFileSpaceDelimiter = True 
      .TextFileOtherDelimiter = "=" 

      .TextFileTrailingMinusNumbers = True 
      .Refresh BackgroundQuery:=False 
     End With 

     strExtension = Dir 
    Loop 

    Application.ScreenUpdating = True 

End Sub 
관련 문제