[發問] 用excel打開筆記本

an13755

各位大師好

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

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

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

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

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

ps:excl檔名為"csv.xls"

lcc_seven

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

LCC大師您誤解我的意思了

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

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

總共要存50個檔案

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

非常感謝您的回答

register313

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

r大師您好

程式執行出現2個問題

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

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

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

還請大師幫忙,謝謝!! csv.rar (5.1 KB)

下載次數: 13

2012-1-5 14:28

GBKEE

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

g大師您好

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

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

謝謝大師的幫忙!!

GBKEE

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

g大師您好

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

謝謝大師的幫忙!!

GBKEE

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

複製代碼