stillfish00

¦^´_ 1# mrkacs

1. Sub Example()
   
2.     Dim sPath As String
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .Title = "½Ð¿ï¾Ü¸ê®Æ§¨"
   
5.         If .Show = -1 Then
   
6.             If .SelectedItems.Count > 0 Then sPath = .SelectedItems(1) Else Exit Sub
   
7.         End If
   
8.     End With
   
9.    
   
10.     Dim oReg As Object: Set oReg = CreateObject("vbscript.regexp")
    
11.     With oReg
    
12.         .MultiLine = True
    
13.         .Global = True
    
14.         .Pattern = "^\s*(\S{1,10}) (\d{2})/(\d{2})/(\d{4}) (\d{2}:\d{2}:\d{2}) (.{15}) (.{10}) (.{10}) (.{6})\s*\r\n(.*)\r\n"
    
15.     End With
    
16.    
    
17.     Dim ws As Worksheet
    
18.     Set ws = Workbooks.Add.Sheets(1)
    
19.    
    
20.     Const ForReading = 1
    
21.     Dim oFSO As Object: Set oFSO = CreateObject("Scripting.FileSystemObject")
    
22.     Dim oTF, oFD, sText
    
23.     Dim curRow As Long
    
24.     Dim match
    
25.     Set oFD = oFSO.getfolder(sPath)
    
26.     For Each f In oFD.Files
    
27.         If oFSO.getextensionname(f.Path) = "txt" Then
    
28.             Set oTF = oFSO.OpenTextFile(f.Path, ForReading)
    
29.             sText = oTF.ReadAll
    
30.             Set match = oReg.Execute(sText)
    
31.             With ws
    
32.                 For Each it In match
    
33.                     curRow = curRow + 1
    
34.                     .Cells(curRow, 1) = Trim(it.submatches(0))
    
35.                     .Cells(curRow, 2) = DateSerial(it.submatches(3), it.submatches(2), it.submatches(1))
    
36.                     .Cells(curRow, 3) = CDate(it.submatches(4))
    
37.                     .Cells(curRow, 4) = Trim(it.submatches(5))
    
38.                     .Cells(curRow, 5) = Trim(it.submatches(6))
    
39.                     .Cells(curRow, 6) = Trim(it.submatches(7))
    
40.                     .Cells(curRow, 7) = Trim(it.submatches(8))
    
41.                     .Cells(curRow, 8) = Trim(it.submatches(9))
    
42.                 Next
    
43.             End With
    
44.         End If
    
45.     Next
    
46.     With ws
    
47.         .[B:B].NumberFormatLocal = "dd/mm/yyyy"
    
48.         .[C:C].NumberFormatLocal = "hh:mm:ss"
    
49.         .UsedRange.EntireColumn.AutoFit
    
50.     End With
    
51.     MsgBox "Finish"
    
52. End Sub

½Æ»s¥N½X

stillfish00

¦^´_ 3# mrkacs

1. Sub Example()
   
2.     Dim sPath As String
   
3.     With Application.FileDialog(msoFileDialogFolderPicker)
   
4.         .Title = "½Ð¿ï¾Ü¸ê®Æ§¨"
   
5.         If .Show = -1 Then
   
6.             If .SelectedItems.Count > 0 Then sPath = .SelectedItems(1) Else Exit Sub
   
7.         End If
   
8.     End With
   
9.    
   
10.     Dim oReg As Object: Set oReg = CreateObject("vbscript.regexp")
    
11.     With oReg
    
12.         .MultiLine = True
    
13.         .Global = True
    
14.         .Pattern = "^\s*(\S{1,10}) (\d{2})/(\d{2})/(\d{4}) (\d{2}:\d{2}:\d{2}) (.{15}) (.{10}) (.{10}) (.{7}) (.{13}) (.{12}) (.{11}) (.*)\r\n(.*)\r\n"
    
15.     End With
    
16.    
    
17.     Dim ws As Worksheet
    
18.     Set ws = Workbooks.Add.Sheets(1)
    
19.    
    
20.     Const ForReading = 1
    
21.     Dim oFSO As Object: Set oFSO = CreateObject("Scripting.FileSystemObject")
    
22.     Dim oTF, oFD, sText
    
23.     Dim curRow As Long
    
24.     Dim match
    
25.     Set oFD = oFSO.getfolder(sPath)
    
26.     For Each f In oFD.Files
    
27.         If oFSO.getextensionname(f.Path) = "csv" Then
    
28.             Set oTF = oFSO.OpenTextFile(f.Path, ForReading)
    
29.             sText = oTF.ReadAll
    
30.             Set match = oReg.Execute(sText)
    
31.             With ws
    
32.                 For Each it In match
    
33.                     curRow = curRow + 1
    
34.                     .Cells(curRow, 1) = Trim(it.submatches(0))
    
35.                     .Cells(curRow, 2) = DateSerial(it.submatches(3), it.submatches(2), it.submatches(1))
    
36.                     .Cells(curRow, 3) = CDate(it.submatches(4))
    
37.                     For j = 4 To 7
    
38.                         .Cells(curRow, j) = Trim(it.submatches(j + 1))
    
39.                     Next
    
40.                     .Cells(curRow, 8) = CDate(it.submatches(9))
    
41.                     .Cells(curRow, 9) = CDate(it.submatches(10))
    
42.                     .Cells(curRow, 10) = CDate(it.submatches(11))
    
43.                     .Cells(curRow, 11) = Trim(it.submatches(12))
    
44.                     .Cells(curRow, 12) = Trim(it.submatches(13))
    
45.                 Next
    
46.             End With
    
47.         End If
    
48.     Next
    
49.     With ws
    
50.         .[B:B].NumberFormatLocal = "dd/mm/yyyy"
    
51.         .[C:C,H:J].NumberFormatLocal = "hh:mm:ss"
    
52.         .UsedRange.EntireColumn.AutoFit
    
53.     End With
    
54.     MsgBox "Finish"
    
55. End Sub

½Æ»s¥N½X