Board logo

標題: [發問] 用excel打開筆記本 [打印本頁]
作者: an13755    時間: 2012-1-4 22:56     標題: 用excel打開筆記本

本帖最後由 an13755 於 2012-1-4 23:29 編輯

各位大師好

小女子有1問題請教,想複製工作表1範圍a1:a20

打開筆記本程式貼上,並將其儲存成檔名"1.txt"

儲存路徑為C:\Documents and Settings\Administrator\My Documents\新資料夾

工作表從1到50,總共要做50次1樣的動作

還請各位大師幫忙,多方協助,不勝感激

ps:excl檔名為"csv.xls"
作者: lcc_seven    時間: 2012-1-4 23:54

1.Excel檔你就自己建立吧！
2.因為存取C:\Documents and Settings\Administrator會有權限問題，所以我改為D:\
3.50個sheet實在是太擠了，所以改成動態偵測，不管目前開啟的活頁簿有幾個sheet，會擷取每一個sheet的A1:A20數值寫入1.txt

Sub WriteTxtFile()
Dim WriteFile As String
WriteFile = "D:\1.txt"
Open WriteFile For Output As #1

SheetsCount = Application.Sheets.Count

'寫入資料
For i = 1 To SheetsCount
    Sheets(i).Select
    For j = 1 To 20
        Print #1, Cells(j, 1)
    Next j
Next i
Close #1
End Sub
作者: an13755    時間: 2012-1-5 01:23

LCC大師您誤解我的意思了

工作表1要儲存成檔名"1.txt"

工作表2要儲存成檔名"2.txt"
.
.
工作表50要儲存成檔名"50.txt"

總共要存50個檔案

請勿用動態偵測,因為還有其他不需要複製的工作表

非常感謝您的回答
作者: register313    時間: 2012-1-5 08:02

回復 3# an13755

初學者VBA
  1. Sub ZZ()
  2. Application.ScreenUpdating = False
  3. For i = 1 To 50
  4.   Set sht = Worksheets.Add(After:=Sheets(Sheets.Count))
  5.   Sheets(i).Range("A1:A20").Copy sht.Cells(1, 1)
  6.   sht.Move
  7.   With ActiveWorkbook
  8.     ChDir "C:\"
  9.     ActiveWorkbook.SaveAs Filename:="C:\" & i & ".txt", FileFormat:=xlText, CreateBackup:=False
  10.     .Close True
  11.   End With
  12. Next i
  13. Application.ScreenUpdating = True
  14. End Sub
複製代碼
作者: an13755    時間: 2012-1-5 14:28

r大師您好

程式執行出現2個問題

第1個問題:1.txt檔案打開沒有東西

第2個問題:其他有複製的txt檔,內容皆會出現多餘的符號""

小女子現上傳excl檔及手動複製完成的2個txt檔

還請大師幫忙,謝謝!![attach]9073[/attach]
作者: GBKEE    時間: 2012-1-5 15:29

回復 5# an13755
修改一下
  1. Option Explicit
  2. Sub ZZ()
  3.     Dim Rng As Range, i As Integer
  4.     Application.ScreenUpdating = False
  5.     For i = 1 To 50
  6.         ' i 是數字        ->Sheets(i)   活頁簿視窗上第幾個工作表
  7.         'i & "" 變成字串  ->Sheets(& "") 工作表i
  8.         Set Rng = Sheets(i & "").Range("A1:A20")  'Rng設定為 工作表i的範圍
  9.         With Workbooks.Add(1)                     '新增活頁簿(工作表1張)
  10.             Rng.Copy .Sheets(1).Cells(1)          '複製到新增活頁簿第1 張工作表的[A1]
  11.             .SaveAs Filename:="D:\" & i & ".txt", FileFormat:=xlText, CreateBackup:=False
  12.             .Close True
  13.     End With
  14.     Next i
  15.     Application.ScreenUpdating = True
  16. End Sub
複製代碼
作者: an13755    時間: 2012-1-5 16:06

本帖最後由 an13755 於 2012-1-5 16:20 編輯

g大師您好

打開txt檔案內容,每1行前後皆會出現多餘的符號"

觀察後發現只要原excel檔上字尾有逗號,就會出現""符號

謝謝大師的幫忙!!
作者: GBKEE    時間: 2012-1-5 16:16

回復 7# an13755
請自行消除 ,
1= 4 6 7 13 14 32 37,
1= 9 15 20 27 28 33 36 38,
1= 1 2 17 18 19 21 22 26 30,
1= 3 23 24 29 34,
1= 5 8 10 11 12 16 25 31 35 39,
6= 7 9 10 16 17 35 40,
作者: an13755    時間: 2012-1-5 16:24

g大師您好

逗號是必要的字元,不能消去

謝謝大師的幫忙!!
作者: GBKEE    時間: 2012-1-5 16:51

回復 9# an13755
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng As Range, i As Integer, Fs As Object, A As Object, E As Range
  4.     Application.ScreenUpdating = False
  5.     Set Fs = CreateObject("Scripting.FileSystemObject") 'FileSystemObject 物件 提供對電腦檔案系統的存取。
  6.     For i = 1 To 50
  7.         Set Rng = Sheets(i & "").Range("A1:A20")  'Rng設定為 工作表i的範圍
  8.         Set A = Fs.CreateTextFile("D:\" & i & ".txt", True)    '建立文字檔案
  9.         'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
  10.         '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
  11.         For Each E In Rng
  12.             A.WriteLine (E)
  13.         Next
  14.         A.Close
  15.     Next i
  16.     Application.ScreenUpdating = True
  17. End Sub
複製代碼
作者: register313    時間: 2012-1-5 17:11

本帖最後由 register313 於 2012-1-5 17:15 編輯

回復 9# an13755
回復 9# GBKEE

GBKEE第一版
FileFormat:=xlText 改為 FileFormat:=xlTextPrinter  (另儲TXT檔 改另儲PRN檔)
但PRN檔每一列超過240字元(好像)就會自動換行
  1. Option Explicit
  2. Sub ZZ()
  3.     Dim Rng As Range, i As Integer
  4.     Application.ScreenUpdating = False
  5.     For i = 1 To 50
  6.         ' i 是數字        ->Sheets(i)   活頁簿視窗上第幾個工作表
  7.         'i & "" 變成字串  ->Sheets(& "") 工作表i
  8.         Set Rng = Sheets(i & "").Range("A1:A20")  'Rng設定為 工作表i的範圍
  9.         With Workbooks.Add(1)                     '新增活頁簿(工作表1張)
  10.             Rng.Copy .Sheets(1).Cells(1)          '複製到新增活頁簿第1 張工作表的[A1]
  11.             .SaveAs Filename:="D:\" & i & ".txt", FileFormat:=xlTextPrinter, CreateBackup:=False
  12.             .Close True
  13.     End With
  14.     Next i
  15.     Application.ScreenUpdating = True
  16. End Sub
複製代碼
作者: an13755    時間: 2012-1-5 20:20

g大師您好

您幫了小女子1個大忙,讓我節省不少時間

還細心的編寫註解,指導晚輩

生命中多了些許的時間可以運用

都要感謝您的幫忙,謝謝!!

還有r大師l大師也感謝你們的幫忙

r大師最後的程式也可以,謝謝!!
作者: PJChen    時間: 2012-1-15 16:15

大大您好,
我看了這個發表想到自己有一個類似的問題,不知能否接著發問?我錄製巨集想從excel sheet("booking")的B3:B35複製貼到TXT的筆記本中,並以sheet("booking")的A1儲存格為檔名,但巨集無法錄製,每次都只出現以下幾行?不知問題出在哪裡?可否解決?

Sub copy_to_TXT()
'
' copy_to_TXT 巨集
'

'
    Cells.Select
    Selection.Copy
End Sub
作者: GBKEE    時間: 2012-1-15 19:25

本帖最後由 GBKEE 於 2012-1-17 10:10 編輯

回復 13# PJChen
試試看
  1. Sub Ex()
  2.     Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
  3.     Application.ScreenUpdating = False
  4.     With Workbooks("test")                       '請改成要複製活頁簿的名稱
  5.         Set Rng(1) = .Sheets("booking").[B3:B35]  'Rng(1) 工作表要複製的範圍
  6.         Set Rng(2) = .Sheets("booking").[A1]      'Rng(2) 存檔名稱的儲存格
  7.     End With
  8.     Set Fs = CreateObject("Scripting.FileSystemObject")        'FileSystemObject 物件 提供對電腦檔案系統的存取。
  9.     Set A = Fs.CreateTextFile("D:\" & Rng(2) & ".txt", True)   '建立文字檔案
  10.     'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
  11.     '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
  12.     For Each E In Rng(1)                          '依序處裡複製範圍的儲存格
  13.         A.WriteLine (E)                           '儲存格寫入文字檔
  14.     Next
  15.     A.Close
  16.     Application.ScreenUpdating = True
  17. End Sub
複製代碼
作者: PJChen    時間: 2012-1-16 18:22

GBKEE大大您好,
我的檔案位置及名稱如下P:\BCM\2011 Shipping for NE.xlsx所以我把它改成   With Windows("P:\BCM\2011 Shipping for NE.xlsx\ Workbooks(Booking") ,執行到第04行出了問題,可以幫我看看哪裡改錯了嗎?
作者: GBKEE    時間: 2012-1-16 20:17

回復 15# PJChen
With Workbooks("test")        '請改成要複製活頁簿的名稱   
這檔案已經開啟           With Workbooks("2011 Shipping for NE.xlsx")
這檔案尚未經開啟       With Workbooks.Open("P:\BCM\2011 Shipping for NE.xlsx")
作者: PJChen    時間: 2012-1-16 21:52

不好意思,執行還是有問題,請大師幫忙看看:
    Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
    Application.ScreenUpdating = False
    With Workbooks("2011 Shipping for NE.xlsx")  '請改成要複製活頁簿的名稱(已經打開)
        Set Rng(1) = .Sheet("Booking").[B3:B35]   '這裡就執行不下了
        Set Rng(2) = .Sheet("Booking").[A1]      'Rng(2) 存檔名稱的儲存格
    End With
    Set Fs = CreateObject("Scripting.FileSystemObject")        'FileSystemObject 物件 提供對電腦檔案系統的存取。
    Set A = Fs.CreateTextFile("P:\BCM\Shipping Doc\PJ\HK Packing\" & Rng(2) & ".txt", True)   '建立文字檔案
    'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
    '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
    For Each E In Rng(1)                          '依序處裡複製範圍的儲存格
        A.WriteLine (E)                           '儲存格寫入文字檔
    Next
    A.Close
    Application.ScreenUpdating = True
作者: GBKEE    時間: 2012-1-17 10:09

本帖最後由 GBKEE 於 2012-1-17 10:12 編輯

回復 17# PJChen
14# 有錯 已更正為
Set Rng(1) = .SheetS("Booking").[B3:B35]
作者: PJChen    時間: 2012-1-17 22:18

大師您好,
    For Each E In Rng(1)
        A.WriteLine (E)                           '執行到這裡就停了,請幫幫我
    Next
    A.Close
    Application.ScreenUpdating = True
   
End Sub
作者: GBKEE    時間: 2012-1-18 08:28

回復 19# PJChen
傳上檔案看看
作者: PJChen    時間: 2012-1-18 21:41

[attach]booking[/attach]
請參考檔案.謝謝
作者: GBKEE    時間: 2012-1-19 08:31

回復 21# PJChen
輸入範圍中有錯誤值  請修改如下
  1. For Each E In Rng(1)                          '依序處裡複製範圍的儲存格
  2.         A.WriteLine (E.Text)                           '儲存格寫入文字檔
  3.     Next
  4.    
複製代碼
作者: PJChen    時間: 2012-1-19 11:00

GBKEE,
太謝謝你了,它可以運作正常!但有個小問題想請教,現在資料寫入txt後,它會存在指定的路徑,但我要如何使TXT儲存後能自動打開?可以這麼做嗎?
作者: GBKEE    時間: 2012-1-19 13:24

回復 23# PJChen
  1. Sub Ex()
  2.     Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
  3.     Application.ScreenUpdating = False
  4.     With Workbooks("test")                       '請改成要複製活頁簿的名稱
  5.         Set Rng(1) = .Sheets("booking").[B3:B35]  'Rng(1) 工作表要複製的範圍
  6.         Set Rng(2) = .Sheets("booking").[A1]      'Rng(2) 存檔名稱的儲存格
  7.     End With
  8.     Set Fs = CreateObject("Scripting.FileSystemObject")        'FileSystemObject 物件 提供對電腦檔案系統的存取。
  9.     Set A = Fs.CreateTextFile("D:\" & Rng(2) & ".txt", True)   '建立文字檔案
  10.     'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
  11.     '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
  12.     For Each E In Rng(1)                          '依序處裡複製範圍的儲存格
  13.         A.WriteLine (E.Text)                           '儲存格寫入文字檔
  14.     Next
  15.     A.Close
  16.     Workbooks.Open ("D:\" & Rng(2) & ".txt")
  17.     Application.ScreenUpdating = True
  18. End Sub
複製代碼
作者: PJChen    時間: 2012-1-20 00:42

GBKEE大大,
我將程式修改後可執行,它會依指定路徑存成TXT檔,但當它自動打開時為另一個與TXT同檔名的EXCEL檔,檔案類型為文字檔!請幫我看看哪裡出了問題,我把檔案上傳了.TKS.[attach]9279[/attach]
作者: GBKEE    時間: 2012-1-20 07:53

回復 25# PJChen
Workbooks.Open ("P:\BCM\Interim\" & Rng(2) & ".txt")
修改成
Shell "Cmd /c start P:\BCM\Interim\" & Rng(2) & ".txt"
作者: PJChen    時間: 2012-1-20 10:37

GBKEE,
完全OK.真是謝謝你!
作者: PJChen    時間: 2012-4-22 15:18

回復 26# GBKEE
您好,想請問:
以下存檔的名稱我想再增加一個[A2],但修改後巨集卻無法執行,請幫我看看語法是不是有誤?
        Set Rng(2) = .Sheets("Booking").[A1]               'Rng(2) 存檔名稱的儲存格
        Set Rng(2) = .Sheets("Booking").[A1] & "_" & [A2]                     '修改後的存檔名稱
作者: GBKEE    時間: 2012-4-22 15:29

本帖最後由 GBKEE 於 2012-4-22 17:29 編輯

回復 28# PJChen
更正
  1. Sub Try()
  2.     Windows("Shipping for ACE.xlsx").Activate
  3.     Sheets("Booking").Select
  4.     Dim Rng(1 To 2), Fs As Object, A As Object, E As Range
  5.     '修改成 Rng(1 To 2)
  6.     Application.ScreenUpdating = False
  7.     With Workbooks("Shipping for ACE.xlsx")  '請改成要複製活頁簿的名稱(已經打開)
  8.         Set Rng(1) = .Sheets("Booking").[B1:B40]   'Rng(1) 工作表要複製的範圍
  9.         Set Rng(2) = .Sheets("Booking").[A1]
  10.         Rng(2) = Rng(2) & "_" & Rng(2).Offset(1)
  11.     End With
  12.     Set Fs = CreateObject("Scripting.FileSystemObject")        'FileSystemObject 物件 提供對電腦檔案系統的存取。
  13.     Set A = Fs.CreateTextFile("P:\TXT\" & Rng(2) & ".txt", True)   '建立文字檔案
  14.     For Each E In Rng(1)                          '依序處裡複製範圍的儲存格
  15.         A.WriteLine (E.Text)                           '儲存格寫入文字檔
  16.     Next
  17.     A.Close
  18.     Shell "Cmd /c start P:\TXT\" & Rng(2) & ".txt"  '自動打開TXT檔
  19.     Application.ScreenUpdating = True
  20. End Sub
複製代碼
作者: PJChen    時間: 2012-4-22 16:48

回復 29# GBKEE
G大,
2個方法我都試了,但無法執行,我將檔案上傳,請幫我瞧瞧. TKS.
[attach]10584[/attach]
作者: PJChen    時間: 2012-4-22 18:09

回復 29# GBKEE
G大,
程式執行OK,不過想請問,程式中都沒有看到[A2]的儲存格,為什麼儲存時會自動加上[A2]的儲存格名稱?
作者: GBKEE    時間: 2012-4-22 19:48

回復 31# PJChen
Rng(2).Offset(1)  就是[A2]

Offset 屬性
expression.Offset(RowOffset, ColumnOffset)
expression     必選。該運算式傳回 Range 物件。
RowOffset      選擇性的 Variant。用列數表示的區域位移 (正值、負數或零 (0))。正值表示向下位移，負值表示向上位移。預設值為 0。
ColumnOffset      選擇性的 Variant。用欄數表示的區域位移 (整數、負數或 0 (零))。正值表示右位移，負值表示左。預設值為 0。
作者: PJChen    時間: 2012-4-22 20:13

回復 32# GBKEE

感謝G大說明.
作者: PJChen    時間: 2012-4-22 21:56

回復 32# GBKEE
再請教G大,
為什麼EXCEL的巨集中,有時可以直接使用儲存格位置當成檔案名稱,如: Set Rng(2) = .Sheets("booking").[A1]
有時候又必須使用Offset,如:   Rng(2) = Rng(2) & "_" & Rng(2).Offset(1)
要如何知道何時該用什麼?
作者: PJChen    時間: 2012-5-22 09:26

回復 32# GBKEE
G大,

之前的程式執行宊然出現一個對話框,並且巨集的這一行被標註黃色底:    A.WriteLine (E.Text)         

   [attach]11089[/attach]   
  [attach]11088[/attach]
作者: GBKEE    時間: 2012-5-22 15:07

本帖最後由 GBKEE 於 2012-5-22 15:15 編輯

回復 34# PJChen
如 A=A1      A.Cells(1,1)  =>A1     ,A.Offset(0,0)=>A1  可隨個人喜好
回復 35# PJChen
有錯誤是因  B27:  RAttn:? Mr. Peter Holfelder 中 ? 為 不可見字元 160
程式已修正 符合 印列頁的的格式匯入文字檔中
  1. Sub try()
  2. Windows("Shipping for Holfelder.xlsx").Activate
  3. 'Creat a TXT
  4. Sheets("Booking").Select
  5. Cells.Select
  6. Selection.Copy
  7. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  8. :=False, Transpose:=False
  9. Dim Rng(1 To 2) As Range, Fs As Object, A As Object, E As Range
  10. Dim S As Variant, xS As Variant
  11. Application.ScreenUpdating = False
  12. With Workbooks("Shipping for Holfelder.xlsx") '請改成要複製活頁簿的名稱(已經打開)
  13. 'With Workbooks.Open("P:\Shipping for Holfelder.xlsx") '請改成要複製活頁簿的名稱(尚未打開)
  14. Set Rng(1) = .Sheets("Booking").[B1:B40] 'Rng(1) 工作表要複製的範圍
  15. Set Rng(2) = .Sheets("Booking").[A1] 'Rng(2) 存檔名稱的儲存格
  16. Rng(2) = Rng(2) & "_" & Rng(2).Offset(1) 'Rng(2) 存檔檔名須多加[A2]的儲存格名稱
  17. 'RowOffset 選擇性的 Variant。用列數表示的區域位移 (正值、負數或零 (0))。正值表示向下位移，負值表示向上位移。預設值為 0。
  18. 'ColumnOffset 選擇性的 Variant。用欄數表示的區運算式域位移 (整數、負數或 0 (零))。正值表示右位移，負值表示左。預設值為 0。
  19. End With
  20. Set Fs = CreateObject("Scripting.FileSystemObject") 'FileSystemObject 物件 提供對電腦檔案系統的存取。
  21. Set A = Fs.CreateTextFile("P:\TXT\" & Rng(2) & ".txt", True) '建立文字檔案
  22. 'CreateTextFile 方法 建立一個指定的檔名並且傳回一個用於該檔案讀寫的 TextStream 物件。
  23. '如果可被覆蓋其值為 True，其為 False 時無法覆蓋
  24. Debug.Print Rng(1).Cells(27)
  25. '*** Debug.Print :即時運算視窗 可見到 RAttn:? Mr. Peter Holfelder 中 ? 為 不可見字元 160" ******
  26. Rng(1).Replace ChrW(160), ""   '**** 消除不可字元 160

  28. For Each E In Rng(1) '依序處裡複製範圍的儲存格
  29. S = Split(E, Chr(10))
  30. If UBound(S) > -1 Then '***有換行 的文字
  31. For Each xS In S
  32. A.WriteLine (xS) '儲存格寫入文字檔
  33. Next
  34. Else
  35. A.WriteLine (E.Text) '儲存格寫入文字檔
  36. End If
  37. Next
  38. A.Close
  39. 'Workbooks.Open ("P:\TXT\" & Rng(2) & ".txt") '這會以EXCEL自動打開TXT類型文件
  40. Shell "Cmd /c start P:\TXT\" & Rng(2) & ".txt" '自動打開TXT檔
  41. Application.ScreenUpdating = True
  42. End Sub
複製代碼
作者: PJChen    時間: 2012-5-22 19:39

回復 36# GBKEE
G大,

原來還會有這種問題,感謝你的幫忙,執行沒問題了.



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