[µo°Ý] ¦p¦ó¶×¤J¦h­Ó¸ê®Æ§¨¤å¦rÀɤº®e ¶×¤J¦h­Ó¸ê®Æ§¨¤å¦rÀÉ

luke

¤p§Ì³Ìªñ­è¾ÇVBA,
§Ú·Q±q«ü©w¥Ø¿ýD:\TEST, «ö¤U" ¶×¤J"«ö¶s,
¦Û°Ê¨ú¥X¸ê®Æ§¨¸Ìªº¤å¦rÀÉ(*.ccc)²Ä¤@¦C¤º®e, ½Æ»s©ñ¤Jtest.xls¤¤ªºSheets("IN"), ¥ÑG2¶}©l¨Ì¦¸¶×¤J¸ê®Æ.

¥H¤U¬O§Ú¥Î¥¨¶°¿ý»s¤è¦¡¥u¿ý4­Ó¸ê®Æ§¨  
³Â·Ð½Ð±Ð¥ý¶i!!

Sub Macro1()
'
' Macro1 Macro
'
' §Ö³tÁä: Ctrl+k
'
    Sheets("Sheet1").Select
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\TEST\TT_00011111\00011112.ccc", Destination:=Range("$A$1"))
        .Name = "00011112"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2)
        .TextFileFixedColumnWidths = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Selection.Copy
    Sheets("IN").Select
    Range("G2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\TEST\TT_00012345\12345678.ccc", Destination:=Range("$A$1"))
        .Name = "12345678"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2)
        .TextFileFixedColumnWidths = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Selection.Copy
    Sheets("IN").Select
    Range("G3").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\TEST\TT_00022222\00333333.ccc", Destination:=Range("$A$1"))
        .Name = "00333333"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2)
        .TextFileFixedColumnWidths = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Selection.Copy
    Sheets("IN").Select
    Range("G4").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\TEST\TT_00023456\25153654.ccc", Destination:=Range("$A$1"))
        .Name = "25153654"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 2)
        .TextFileFixedColumnWidths = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Selection.Copy
    Sheets("IN").Select
    Range("G5").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Cells.Select
    Selection.QueryTable.Delete
    Selection.QueryTable.Delete
    Selection.QueryTable.Delete
    Selection.QueryTable.Delete
    Selection.ClearContents
    Sheets("IN").Select
    Range("A1").Select
End Sub

Hsieh

¦^´_ 1# luke

1. Sub ¶×¤J()
   
2. Dim ary() As String, rw As Long, Mystr$, MyPath$
   
3. rw = 2: i = 0
   
4. path1 = "D:\TEST\"
   
5. file1 = Dir(path1 & "*.*", vbDirectory) '¥u³B²z¸ê®Æ§¨
   
6. Do While file1 <> ""
   
7.   If file1 <> "." And file1 <> ".." And _
   
8.      GetAttr(path1 & file1) = vbDirectory Then
   
9.      i = i + 1
   
10.      ReDim Preserve ary(i)
    
11.      ary(i) = file1
    
12.   End If
    
13.   file1 = Dir
    
14. Loop
    
15. For i = 1 To UBound(ary)
    
16.    Cells(rw, 1) = ary(i)
    
17.    MyPath = path1 & ary(i) & "\"
    
18.    fs = Dir(MyPath & "*.ccc")
    
19.    Open MyPath & fs For Input As #1
    
20.    Line Input #1, Mystr
    
21.    Cells(rw, 7) = Mid(Mystr, 2)
    
22.    Close #1
    
23.    rw = rw + 1
    
24. Next i
    
25. End Sub

½Æ»s¥N½X