- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 6# metrostar
- Sub zhz3230()
- Dim D As Object, Tx As Object, i%, TestFile$, MyChar$, ch$
- Dim Fs As Object, OldFile As String, SaveFile%
- Set Fs = CreateObject("Scripting.FileSystemObject")
- TestFile = ThisWorkbook.Path & "\SP20101002.txt" '請修改為正確檔案路徑
- OldFile = ThisWorkbook.Path & "\OldTxt.txt"
- Fs.Copyfile TestFile, OldFile '複製來源檔暫存
- Set D = CreateObject("scripting.dictionary")
- Open TestFile For Input As #1 ' 開啟檔案。
- Do While Not EOF(1) ' 執行迴圈直到檔尾為止。
- Input #1, MyChar ' 將資料讀入變數中。
- If InStr(MyChar, Chr(9)) Then ch = Chr(9) Else ch = Space(1) '取得解析字元
- D(Trim(Split(MyChar, ch)(0) & "")) = "" '取的舊資料
- Loop
- Close #1 ' 關閉檔案。
- Set Tx = Fs.OpenTextFile(TestFile, 8, -2)
- With Sheets("Sheet1")
- For i = 2 To .[a65536].End(3).Row
- If D.exists(Trim(.Cells(i, 2))) = False Then ' Sheet1的B欄 比對舊資料
- Tx.WriteLine .Cells(i, 2) & " " & .Cells(i, 1) '寫入檔案
- End If
- Next
- End With
- Tx.Close ' 關閉檔案。
- Set Tx = Nothing
- Set D = Nothing
- '覆蓋原舊檔名-> 原來檔案存檔 ->不動它
- '建新檔名 -> 原來檔案不存檔
- If MsgBox("確定 建新檔名??", vbQuestion + vbYesNo, "另存新檔") = vbYes Then
- With Application.FileDialog(msoFileDialogOpen)
- .AllowMultiSelect = False
- .FilterIndex = 6
- If .Show = True Then
- Fs.Copyfile TestFile, .SelectedItems(1) '複製來源檔
- Fs.Copyfile OldFile, TestFile '還原來源檔 -> 原來檔案不存檔
- End If
- End With
- End If
- Kill OldFile '清除來源暫存檔
- End Sub
|
|
發表於 2010-10-8 21:05
| 
