Joforn

¦^´_ 1# ljuber

1. Private Sub StartLoadText()
   
2.     Const ColumnsNum As Long = 7
   
3.     Dim strFind   As String
   
4.     Dim Value()   As Variant, valRow() As String
   
5.     Dim StartRow  As Long
   
6.     Dim textFile  As String
   
7.     Dim bytArr()  As Byte
   
8.     Dim I As Long, J As Long
   
9.     Dim TextFileName As Variant
   
10.     Dim RegExp    As Object
    
11.     Dim Matchs    As Object
    
12.    
    
13.     On Error Resume Next
    
14.     Set RegExp = CreateObject("VBScript.RegExp")
    
15.     If RegExp Is Nothing Then Exit Sub
    
16.     TextFileName = Application.GetOpenFilename(FileFilter:="Text File,*.TXT", FilterIndex:=1, Title:="Please Change a Text File")
    
17.     StartRow = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row
    
18.     If StartRow < 2 Then Exit Sub
    
19.     If VarType(TextFileName) = vbString Then
    
20.         I = FileLen(TextFileName)
    
21.         If I < 1 Then Exit Sub
    
22.         ReDim bytArr(0 To I - 1)
    
23.         I = FreeFile
    
24.         Open TextFileName For Binary As I
    
25.         Get I, , bytArr()
    
26.         Close I
    
27.         textFile = StrConv(bytArr, vbUnicode)
    
28.         Erase bytArr
    
29.         With RegExp
    
30.             .Global = True
    
31.             .IgnoreCase = True
    
32.             If StartRow > 2 Then
    
33.                 .Pattern = "(\S+\t){4}((" & Join(Application.WorksheetFunction.Transpose(Sheet2.Range("A2:A" & StartRow).Value), ")|(") & "))(\t.+)*"
    
34.             Else
    
35.                 .Pattern = "(\S+\t){4}(" & Sheet2.Range("A2").Value & ")(\t.+)*"
    
36.             End If
    
37.             Set Matchs = .Execute(textFile)
    
38.         End With
    
39.         With Matchs
    
40.             ReDim Value(0 To .Count - 1, 0 To ColumnsNum - 1)
    
41.             For I = 0 To .Count
    
42.                 valRow = Split(.Item(I), vbTab)
    
43.                 For J = 0 To ColumnsNum - 1
    
44.                   Value(I, J) = valRow(J)
    
45.                 Next J
    
46.             Next I
    
47.         End With
    
48.         Set Matchs = Nothing: Set RegExp = Nothing
    
49.         StartRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
    
50.         StartRow = StartRow + 1
    
51.         Application.ScreenUpdating = False
    
52.         Sheet1.Range("A" & StartRow).Resize(I - 1, ColumnsNum).Value = Value
    
53.         Application.ScreenUpdating = True
    
54.     End If
    
55. End Sub

½Æ»s¥N½X

¹B¦æªþ¥ó ½m²ß.zip (350.79 KB)

¤U¸ü¦¸¼Æ: 5

2016-1-22 00:40

¤¤ªº«ö¶s¡G