請問如何將存檔如表格一樣

Sub Trans()
Dim myDir As String, myRng As Range
Dim i As Integer
myDir = ThisWorkbook.Path '指定路徑為工作表所在目錄
ChDrive myDir
ChDir myDir
Set myRng = Range("A1").CurrentRegion '定義要抓取的範圍
Dim MyTxt As String
Dim filename As String
'定義檔名為時間
filename = Format(Now(), "yyyymmddhhmmss") & ".txt"
'開啟檔案寫入，若路徑中未有該檔案會create一個
Open filename For Output As #1
'第一列不抓進來，一直取到最後一列
For i = 1 To myRng.Rows.Count
MyTxt = myRng.Cells(i, 1).Text + myRng.Cells(i, 2).Text + myRng.Cells(i, 3).Text + myRng.Cells(i, 4).Text + myRng.Cells(i, 5).Text
Print #1, MyTxt
Next
Close #1
MsgBox ("存檔成功! ")
End Sub

複製代碼

如下圖一樣，謝謝

2014-09-19_203402.jpg (37.84 KB)

testtxt.rar (14.34 KB)

樓主熱帖

wufonna

中學生 Rank: 2

帖子: 161
主題: 26
精華: 0
積分: 187
點名: 0
作業系統: xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: TW
註冊時間: 2011-1-2
最後登錄: 2022-2-16

2^#

發表於 2014-9-20 19:00 | 顯示全部帖子

回復 2# luhpro

謝謝 luhpro 大大，程式可執行 ^_^
諸問大大 MyTxt = MyTxt & Left(.Cells(i, j) & Space(16), aLen(j - 1) - Len(.Cells(i, j)) * -(i = 1))
中的 *-(i = 1) 的作用
謝謝

TOP

wufonna

中學生 Rank: 2

帖子: 161
主題: 26
精華: 0
積分: 187
點名: 0
作業系統: xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: TW
註冊時間: 2011-1-2
最後登錄: 2022-2-16

3^#

發表於 2014-9-20 22:24 | 顯示全部帖子

本帖最後由 wufonna 於 2014-9-20 22:27 編輯

回復 4# bobomi

請問大大
a =  -(i = 1)
當 i = 1 時,       a = 1
當 i = 其他值時, a = 0

當=1
debug
i=1 是 True
i 不是 1
i = 1 是 flase

而
i=1  -(i = 1)  是 1
i 不是 1  -(i = 1) 是 0
謝謝

意即用數學式取代 IF or IIF

IF i = 1 then
b = Len(.Cells(i, j))
else
  b = 0
end if

原來是這樣
沒看清楚
謝謝大大

TOP

wufonna

中學生 Rank: 2

帖子: 161
主題: 26
精華: 0
積分: 187
點名: 0
作業系統: xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: TW
註冊時間: 2011-1-2
最後登錄: 2022-2-16

4^#

發表於 2014-9-22 15:05 | 顯示全部帖子

回復 7# luhpro
回復 6# bobomi

謝謝 bobomi 大 luhpro 大
參考站上的資料 http://forum.twbts.com/thread-31-1-1.html 用 StrConv 是否那要改進的謝謝

Sub Test()
GetDividend ("2002")
'取得網頁表格格式化為文字表格
End Sub
Private Sub GetDividend(ByVal ss As String) '取股利網頁
Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
Dim hh As String, T As Date, i, ii, S As Object
Dim filename As String, varVar As String
T = Time
hh = "http://dj.mybank.com.tw/z/zc/zcc/zcc_" & ss & ".asp.htm"
With ie
.Navigate hh
Do While .readyState <> 4 '等待網頁下載完畢
DoEvents
If Time >= T + #12:00:03 AM# Then '等待8秒 3秒太少會誤錯改8妙
DoEvents
Application.SendKeys "~" '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
Exit Do
End If
Loop
''***不是等待8秒 3秒太少會誤錯改8妙 ***
Do
Set S = .Document.getElementsByTagName("table")(3) '
Loop Until Not S Is Nothing
'*** 勝一沒捉到 ????
'*** 因程式運行太快 , S Is Nothing, S 尚未指定為.Document.getElementsByTagName("table")(4)
'*** 程式已經執行下一行, With 工作表2 的程式碼
filename = ss & "_" & Format(Now(), "yyyymmddhhmmss") & ".txt"
Open filename For Output As #1
For i = 0 To S.Rows.Length - 1 '寫入資料
varVar = ""
For ii = 0 To S.Rows(i).Cells.Length - 1 ' S.Rows(i).Cells.Length - 1 才是正確
varVar = varVar & Left(S.Rows(i).Cells(ii).innerText & Space(16), 12 - (LenB(StrConv(S.Rows(i).Cells(ii).innerText, vbFromUnicode)) - Len(S.Rows(i).Cells(ii).innerText)))
'http://forum.twbts.com/thread-31-1-1.html Len / LenB - 字串長度判斷方式的探討
DoEvents
Next
Print #1, varVar
Next
Close #1
' MsgBox ("存檔成功! ")
End With
End Sub

複製代碼

TOP

wufonna

中學生 Rank: 2

帖子: 161
主題: 26
精華: 0
積分: 187
點名: 0
作業系統: xp
軟體版本: office 2010
閱讀權限: 20
性別: 男
來自: TW
註冊時間: 2011-1-2
最後登錄: 2022-2-16

5^#

發表於 2014-9-22 18:34 | 顯示全部帖子

請問大大
這網頁有個換行
我多加了
varVar = Replace(varVar, Chr(10), " ") '取代換行為空格
文字檔內還有1 個黑格
請問大大是那裡有錯
謝謝

Sub Test()
GetDividend ("2002")
'取得網頁表格格式化為文字表格
End Sub
Private Sub GetDividend(ByVal ss As String) '取股利網頁
Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
Dim hh As String, T As Date, i, ii, S As Object
Dim filename As String, varVar As String
T = Time
' hh = "http://dj.mybank.com.tw/z/zc/zcc/zcc_" & ss & ".asp.htm"
hh = "http://yamstock.megatime.com.tw/asp/stockinfo/GetReport.asp?select_table=html\Finain_Full\&stockid=" & ss & "&name1=D5&index1=5"
With ie
.Navigate hh
Do While .readyState <> 4 '等待網頁下載完畢
DoEvents
If Time >= T + #12:00:03 AM# Then '等待8秒 3秒太少會誤錯改8妙
DoEvents
Application.SendKeys "~" '股票代號錯誤,網頁會有訊息,須按確定,才可繼續下面股票代號
Exit Do
End If
Loop
''***不是等待8秒 3秒太少會誤錯改8妙 ***
Do
Set S = .Document.getElementsByTagName("table")(4) '
Loop Until Not S Is Nothing
'*** 勝一沒捉到 ????
'*** 因程式運行太快 , S Is Nothing, S 尚未指定為.Document.getElementsByTagName("table")(4)
'*** 程式已經執行下一行, With 工作表2 的程式碼
filename = ss & "_" & Format(Now(), "yyyymmddhhmmss") & ".txt"
Open filename For Output As #1
For i = 0 To S.Rows.Length - 1 '寫入資料
varVar = ""
For ii = 0 To S.Rows(i).Cells.Length - 1 ' S.Rows(i).Cells.Length - 1 才是正確
varVar = varVar & Left(S.Rows(i).Cells(ii).innerText & Space(14), 14 - (LenB(StrConv(S.Rows(i).Cells(ii).innerText, vbFromUnicode)) - Len(S.Rows(i).Cells(ii).innerText)))
'http://forum.twbts.com/thread-31-1-1.html Len / LenB - 字串長度判斷方式的探討
varVar = Replace(varVar, Chr(10), " ")
DoEvents
Next
Print #1, varVar
Next
Close #1
' MsgBox ("存檔成功! ")
End With
End Sub