返回列表 上一主題 發帖

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

metrostar

帖子
55 
主題
20 
精華
0 
積分
80 
點名
0  
作業系統
winxp 
軟體版本
officexp 
閱讀權限
20 
性別
女 
註冊時間
2010-7-5 
最後登錄
2013-8-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 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 新資料會增加,舊資料原封不動,要儲存複蓋原檔案

metrostar308.rar (55.74 KB)

收藏 分享

metrostar

帖子
55 
主題
20 
精華
0 
積分
80 
點名
0  
作業系統
winxp 
軟體版本
officexp 
閱讀權限
20 
性別
女 
註冊時間
2010-7-5 
最後登錄
2013-8-25 
2#
發表於 2010-10-8 11:41 | 只看該作者
學妹問題還沒有解決啦,就是輸出 *.txt
A列跟B列對調且原有跟EXCEL檔不要複蓋,僅增加新內容

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

幫忙學妹完成

謝謝了

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 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 對嗎?
這說明看不懂 不知要如何比對

TOP

metrostar

帖子
55 
主題
20 
精華
0 
積分
80 
點名
0  
作業系統
winxp 
軟體版本
officexp 
閱讀權限
20 
性別
女 
註冊時間
2010-7-5 
最後登錄
2013-8-25 
4#
發表於 2010-10-8 21:59 | 只看該作者
首先多謝帥哥版主回覆

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2010-10-9 10:10 | 只看該作者
回復 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
複製代碼

TOP

metrostar

帖子
55 
主題
20 
精華
0 
積分
80 
點名
0  
作業系統
winxp 
軟體版本
officexp 
閱讀權限
20 
性別
女 
註冊時間
2010-7-5 
最後登錄
2013-8-25 
6#
發表於 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 或是想建新檔名 那更棒

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2010-10-14 09:21 | 只看該作者
回復 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
複製代碼

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題