[發問] 問題二.從excel直接轉出到 C:\SP20101002.TXT 檔案中去?

metrostar

學妹又來麻煩大家了

請帥哥/美女版主 帥哥/美女學長跟學姐

幫忙學妹完成

謝謝了

SP20101002 為舊資料
SP20101001 為新資料(檔案中不存在也不出現的,目的是對照參考用的)

原有舊資料 SP20101002.TXT (已經存在內容)
如果轉出的資料,舊資料沒有的要增加,如果舊資料已經有了就不管它
往下判斷

判斷方法是這樣的,考慮第一個空格為準
只考慮空格左前為基準,空格後的內容不理它

三個小例子

新資料

3A 12
A&M 5959
A50CHT 0703

舊檔案
SP20101002.TXT

1. 有了 3A        0012 3A訧埭 ,只考慮 3A 有了跳過往下一格
2. 有了 A&M        5959 A&M華莉,只考慮 A&W 有了跳過往下一格
3. 只有 A50CHTK-C1        0703C1 A50笢弊價踢 沒有 A50CHT , 所以 SP20101002.TXT 要新這筆

最終只有一個 SP20101002.TXT 新資料會增加,舊資料原封不動,要儲存複蓋原檔案

metrostar

學妹問題還沒有解決啦,就是輸出 *.txt
A列跟B列對調且原有跟EXCEL檔不要複蓋,僅增加新內容

請帥哥/美女版主 帥哥/美女學長跟學姐

幫忙學妹完成

謝謝了

GBKEE

舊檔案 SP20101002.TXT
1. 有了 3A        0012 3A訧埭 ,只考慮 3A 有了跳過往下一格
2. 有了 AM        5959 A&M華莉,只考慮 A&W 有了跳過往下一格
3. 只有 A50CHTK-C1        0703C1 A50笢弊價踢 沒有 A50CHT , 所以 SP20101002.TXT 要新這筆
metrostar 發表於 2010-10-6 17:06

你要的是 metrostar308.xls 要和 SP20101002.TXT 比對之後 有新的資料加到 SP20101002.TXT 對嗎?
這說明看不懂 不知要如何比對

metrostar

首先多謝帥哥版主回覆

對的就是這意思
只比對空格左前為基準,空格後的內容不比對

GBKEE

回復 4# metrostar
只比對空格左前為基準, 和Sheet1的B欄比對嗎?
CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
OpenTextFile   方法 開啟一個指定的檔案並傳回一個 TextStream 物件，該物件可用於對檔案進行讀取或附加。

1. Option Explicit
   
2. Sub zhz3230()
   
3.     Dim D As Object, Tx As Object, i%, TestFile$, MyChar$, ch$
   
4.     TestFile = ThisWorkbook.Path & "\SP20101002.txt"   '請修改為正確檔案路徑
   
5.     Set D = CreateObject("scripting.dictionary")
   
6.     Open TestFile For Input As #1                      ' 開啟檔案。
   
7.     Do While Not EOF(1)                                ' 執行迴圈直到檔尾為止。
   
8.         Input #1, MyChar                               ' 將資料讀入變數中。
   
9.         If InStr(MyChar, Chr(9)) Then ch = Chr(9) Else ch = Space(1)   '取得解析字元
   
10.         D(Trim(Split(MyChar, ch)(0) & "")) = ""        '取的舊資料
    
11.     Loop
    
12.     Close #1                                           ' 關閉檔案。
    
13.     Set Tx = CreateObject("scripting.FileSystemObject").OpenTextFile(TestFile, 8, -2)
    
14.     With Sheets("Sheet1")
    
15.      For i = 2 To .[a65536].End(3).Row
    
16.       If D.exists(Trim(.Cells(i, 2))) = False Then      ' Sheet1的B欄 比對舊資料
    
17.          Tx.WriteLine .Cells(i, 2) & " " & .Cells(i, 1) '寫入檔案
    
18.       End If
    
19.     Next
    
20.     End With
    
21.     Set Tx = Nothing
    
22.     Set D = Nothing
    
23. End Sub

複製代碼

metrostar

回復  metrostar
只比對空格左前為基準, 和Sheet1的B欄比對嗎?
CreateTextFile 方法 建立一個指定的檔名 ...
GBKEE 發表於 2010-10-9 10:10

嘩 棒極了
完全達到耶
學妹真的非常感動呢
太感謝 GBKEE 帥哥版主(老師)您了
您真是太強太厲害了
感謝您並祝賀您
幸福好運永遠降臨您身上

看到就不會加入
非常傷腦筋

如果增加 開啟某路徑檔案

   With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "*.txt"
        .Show
        If .SelectedItems.Count > 0 Then
            fs = .SelectedItems(1)
        Else
            MsgBox "沒有選取檔案 !!!"
            Exit Sub
        End If
    End With

處理後

結束為出現訊息 想覆蓋原舊檔名呢 Y OR N 或是想建新檔名 那更棒

GBKEE

回復 6# metrostar
   

1. Sub zhz3230()
   
2.     Dim D As Object, Tx As Object, i%, TestFile$, MyChar$, ch$
   
3.     Dim Fs As Object, OldFile As String, SaveFile%
   
4.     Set Fs = CreateObject("Scripting.FileSystemObject")
   
5.     TestFile = ThisWorkbook.Path & "\SP20101002.txt"   '請修改為正確檔案路徑
   
6.     OldFile = ThisWorkbook.Path & "\OldTxt.txt"
   
7.     Fs.Copyfile TestFile, OldFile                      '複製來源檔暫存
   
8.     Set D = CreateObject("scripting.dictionary")
   
9.     Open TestFile For Input As #1                      ' 開啟檔案。
   
10.     Do While Not EOF(1)                                ' 執行迴圈直到檔尾為止。
    
11.         Input #1, MyChar                               ' 將資料讀入變數中。
    
12.         If InStr(MyChar, Chr(9)) Then ch = Chr(9) Else ch = Space(1)   '取得解析字元
    
13.         D(Trim(Split(MyChar, ch)(0) & "")) = ""        '取的舊資料
    
14.     Loop
    
15.     Close #1                                           ' 關閉檔案。
    
16.     Set Tx = Fs.OpenTextFile(TestFile, 8, -2)
    
17.     With Sheets("Sheet1")
    
18.      For i = 2 To .[a65536].End(3).Row
    
19.       If D.exists(Trim(.Cells(i, 2))) = False Then      ' Sheet1的B欄 比對舊資料
    
20.          Tx.WriteLine .Cells(i, 2) & " " & .Cells(i, 1) '寫入檔案
    
21.       End If
    
22.     Next
    
23.     End With
    
24.     Tx.Close                                              ' 關閉檔案。
    
25.     Set Tx = Nothing
    
26.     Set D = Nothing
    
27.     '覆蓋原舊檔名-> 原來檔案存檔  ->不動它
    
28.     '建新檔名    -> 原來檔案不存檔
    
29.     If MsgBox("確定 建新檔名??", vbQuestion + vbYesNo, "另存新檔") = vbYes Then
    
30.             With Application.FileDialog(msoFileDialogOpen)
    
31.                 .AllowMultiSelect = False
    
32.                 .FilterIndex = 6
    
33.                 If .Show = True Then
    
34.                     Fs.Copyfile TestFile, .SelectedItems(1)                       '複製來源檔
    
35.                     Fs.Copyfile OldFile, TestFile                                 '還原來源檔  -> 原來檔案不存檔
    
36.                 End If
    
37.             End With
    
38.     End If
    
39.     Kill OldFile                '清除來源暫存檔
    
40. End Sub

複製代碼