麻辣家族討論版版 - Powered by Discuz! Board

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

作者: metrostar 時間: 2010-10-6 17:06 標題: 問題二.從excel直接轉出到 C:\SP20101002.TXT 檔案中去?

學妹又來麻煩大家了

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

幫忙學妹完成

謝謝了

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 時間: 2010-10-8 11:41

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

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

幫忙學妹完成

謝謝了

作者: GBKEE 時間: 2010-10-8 21:05

舊檔案 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 時間: 2010-10-8 21:59

首先多謝帥哥版主回覆

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

作者: GBKEE 時間: 2010-10-9 10:10

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

Option Explicit
Sub zhz3230()
Dim D As Object, Tx As Object, i%, TestFile$, MyChar$, ch$
TestFile = ThisWorkbook.Path & "\SP20101002.txt" '請修改為正確檔案路徑
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 = CreateObject("scripting.FileSystemObject").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
Set Tx = Nothing
Set D = Nothing
End Sub

複製代碼

作者: metrostar 時間: 2010-10-13 15:08

回復 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 時間: 2010-10-14 09:21

回復 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

複製代碼

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)