- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
18#
發表於 2015-10-4 16:22
| 只看該作者
回復 17# Jason80Lo
試試看- Option Explicit
- Private Sub EX()
- Dim xPath As String, Rng(1 To 2) As Range, xFile As String, a As Variant, r As String
- Dim i As Boolean, f As Integer, xString, xMatch As Variant
- Dim S As Worksheet, AR(), x_Row As Integer
-
- If Join(AR, "") = "" Then ReDim AR(0) '為空陣列,陣列宣告為一元素
- If IsArray([xFile_Add]) Then AR = [xFile_Add] '當活頁簿的名稱是陣列
- ' [xFile_Add] -> [這活頁簿的名稱或函數]
- Set S = ActiveWorkbook.ActiveSheet
- Set Rng(1) = S.Rows(1) '使用中活頁簿,這工作表的第一列
- xPath = "C:\Users\j\Desktop\新增資料夾 (4)\" 'txt 檔案的目錄
- xFile = Dir(xPath & "*.txt") '搜尋附檔名
- Do While xFile <> "" '找到
- xMatch = Application.Match(xFile, AR, 0) '陣列中搜尋
- If IsError(xMatch) Then '陣列中搜尋沒有這txt檔
- If Join(AR, "") = "" Then
- AR(0) = xFile '陣列第一元素=xFile
- Else
- ReDim Preserve AR(0 To UBound(AR) + 1) '陣列上限元素+1
- AR(UBound(AR)) = xFile
- End If
- Set Rng(2) = Rng(1).Cells(Application.CountA(Rng(1)) + 1) '依序在第一列中
- i = True
- Rng(2).Cells = xFile '檔名寫入儲存格中
- f = FreeFile
- Open xPath & xFile For Input Access Read As #1 '開啟文字檔
- Do Until EOF(1) '執行迴圈直到檔尾為止。
- Line Input #1, xString '將資料讀入變數中。
- a = Split(xString, Space(1)) '該檔案以,為分隔符號
- 'Split 的型態Variant
- If i Then
- Rng(2).Cells(2, 1).Resize(UBound(a) + 1) = Application.Transpose(a)
- i = 0
- Else
- With Rng(2).End(xlDown).Offset(1)
- .Resize(UBound(a) + 1) = Application.Transpose(a)
- End With
- End If
- Loop
- Close #f ' 關閉檔案。
- End If
- xFile = Dir '查下一個 txt檔
- Loop
- If Join(AR, "") <> "" Then ThisWorkbook.Names.Add "xFile_Add", AR '這活頁簿的名稱 內容為這陣列,
- End Sub
|
|
發表於 2015-9-24 23:05
| 
