123456
返回列表 上一主題 發帖

[發問] 可否用迴圈或變數匯入大量資料？

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
11# 跳轉到 »
發表於 2014-4-25 05:23 | 顯示全部帖子
本帖最後由 smart3135 於 2014-4-25 05:25 編輯

回復 8# GBKEE
GBKEE版主您好，昨天您提到將EXCEL匯入的資料存入指定的txt，我用逐行執行，發現它是用迴圈的方式，將EXCEL匯入的資料一列一列的存入指定的txt中
直到遇到空白資料即停止迴圈不再存入，想請問若要將EXCEL匯入的資料存入到txt中，是只能用這種一列一列存入的方式嗎？
這種方式應該就像是點選EXCEL的第一列，然後按滑鼠右鍵複製(或Ctrl+C)，再貼到txt中的第一列，第二列資料就換到EXCEL第二列重覆一樣的動作
直到沒有資料能貼上為止，不知道我這樣解讀對不對，主要是想請問，有沒有方法能讓EXCEL資料，像點選EXCEL左上角的全選(Cells.select)，然後直接全部複製，
再全部直接貼到txt中，這樣應該就不用走迴圈，一次貼上即可，因為不清楚VBA有沒有語法能做到這樣，所以要再請您幫忙解惑一下囉！感謝！
  1. Sub Maketxt(xF As String, Q As QueryTable)   '將匯入資料存入指定的txt
  2.     Dim fs As Object, E As Range, C As Variant
  3.     Set fs = CreateObject("Scripting.FileSystemObject")
  4.     Set fs = fs.CreateTextFile(xF, True)  '創見一個檔案,如檔案存在可覆蓋掉
  5.     For Each E In Q.ResultRange.Rows
  6.         C = Application.Transpose(Application.Transpose(E.Value))
  7.         C = Join(C, vbTab)
  8.         fs.WriteLine C
  9.     Next
  10.     fs.Close
  11. End Sub
複製代碼

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
12#
發表於 2014-4-25 06:21 | 顯示全部帖子
本帖最後由 smart3135 於 2014-4-25 06:22 編輯

回復 18# GBKEE
不好意思，又發現一個問題要來請教您了，先前有向您請教當損益季表(合併財報)的資料抓不到時，就去抓損益表(季表)，其中的關鍵字是在A3儲存格
鍵入查無，則第一個連結抓不到時就會去抓第二個連結的資料，但我在試著抓損益年表時，當個股不存在時，不是出現個股代碼錯誤，而是在A3出現查無損益年表(合併報表)
這時會去抓第二個連結，結果一樣會在A3出現查無損益年表，這時就無法跳出迴圈，變成一直在迴圈裡打轉了，兩個無法抓取資料的連結都在A3出現相同的關鍵字
以致程式碼無法區別，就持續走無盡迴圈，不知道這個問題有沒有辦法解決？資料一次貼上的方式我會再慢慢try，感謝您耐心的回答，謝謝！
  1. Option Explicit
  2. Sub 抓年損益表資料()
  3.     Dim E As Integer, URL As String, xPath As String, xFile As String
  4.     Dim Msg As Boolean
  5.     URL = "URL;https://djinfo.cathaysec.com.tw/z/zc/zcq/zcqa/zcqa.djhtm?A="
  6.     xPath = "G:\財報資料"
  7.     With ThisWorkbook
  8.         With .Sheets(1)      '活頁簿的第 1 張工作表
  9.             If .QueryTables.Count = 0 Then
  10.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  11.                     .Refresh BackgroundQuery:=False
  12.                 End With
  13.             End If
  14.             For E = 1341 To 2000
  15. ER:
  16.                 With .QueryTables(1)
  17.                     If Msg = False Then
  18.                       .Connection = URL & E
  19.                     ElseIf Msg Then
  20.                     'https://djinfo.cathaysec.com.tw/z/zc/zcq/zcqa/zcqa0_1339_ACC.djhtm   損益表(年表)
  21.                        .Connection = "URL;https://djinfo.cathaysec.com.tw/z/zc/zcq/zcqa/zcqa0_" & E & "_ACC.djhtm"
  22.                     End If
  23.                     .PreserveFormatting = True
  24.                     .BackgroundQuery = True
  25.                     .RefreshStyle = xlInsertDeleteCells
  26.                     .SaveData = True
  27.                     .AdjustColumnWidth = True
  28.                     .RefreshPeriod = 0
  29.                     .WebSelectionType = xlSpecifiedTables
  30.                     .WebFormatting = xlWebFormattingNone
  31.                     .WebTables = "3"
  32.                     .WebPreFormattedTextToColumns = True
  33.                     .WebConsecutiveDelimitersAsOne = True
  34.                     .Refresh BackgroundQuery:=False
  35.                 End With
  36.                 If InStr(.[A3], "查無") Then Msg = True: GoTo ER
  37.                 If InStr(.[A3], "個股代碼錯誤") = False Then '這網頁如股票代碼錯誤會傳回負號.
  38.                      xFile = xPath & "\" & E & "\IS.txt"
  39.                     MkDir_Sub xFile       '10#的程式 'C槽下的季損益表資料夾不需先建立
  40.                     Maketxt xFile, .QueryTables(1)
  41.                 End If
  42.                 Msg = False
  43.             Next
  44.         End With
  45.     End With
  46. End Sub
複製代碼

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
13#
發表於 2014-4-25 06:44 | 顯示全部帖子
回復 18# GBKEE
抱歉，剛剛試著試著，好像成功了，造成您的困擾，真不好意思！

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
14#
發表於 2014-4-25 10:43 | 顯示全部帖子
本帖最後由 smart3135 於 2014-4-25 10:46 編輯

回復 21# GBKEE

1420月營收



GBKEE版主您好，請見以上連結，目前已無1420這支個股，因為1420潤泰紡織已併入2915潤泰全，但該網站仍將1420直接顯示2915潤泰全的合併月膋收
在VBA在擷取合併月營收時仍會擷取到資料，我試了很久，try了很多條件仍無法避免，不知能否利用VBA寫出類似像您在21#回覆的程式碼避免擷取到這種已無個股代號的資料呢？謝謝！

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
15#
發表於 2014-4-25 11:52 | 顯示全部帖子
回復 23# GBKEE
GBKEE版主您好，將您的程式碼套入之後是可以將1420跳過不抓資料了，不過因為1420也是在迴圈變數E的其中一碼，是不是無法用迴圈方式去避免抓取資料
只能一個一個像這樣[If E = 1420 Then GoTo xlNext]設定讓它跳過呢？因為像這種股票還真不少，要一個一個找出來可能要花些功夫
另外像這段[If InStr(.[A3], "查無") And Msg = True Or E = 2149 Then GoTo xlNext]當中的2149是代表什麼呢？我把Or E = 2149拿掉似乎不影響擷取資料
這個網站的資料出現"查無"是在A2儲存格，所以我把A3改成A2，附上程式碼，謝謝！
  1. Option Explicit
  2. Sub 抓季月營收資料()
  3.     Dim E As Integer, URL As String, xPath As String, xFile As String
  4.     Dim Msg As Boolean
  5.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCH/ZCH.DJHTM?A="
  6.     xPath = "G:\財報資料"
  7.     With ThisWorkbook
  8.         With .Sheets(1)      '活頁簿的第 1 張工作表
  9.             If .QueryTables.Count = 0 Then
  10.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  11.                     .Refresh BackgroundQuery:=False
  12.                 End With
  13.             End If
  14.                 Rows(1).Delete
  15.                 Columns(1).Delete
  16.             For E = 1101 To 3000
  17. ER:
  18.                 With .QueryTables(1)
  19.                     .Connection = URL & E
  20.                     .PreserveFormatting = True
  21.                     .BackgroundQuery = True
  22.                     .RefreshStyle = xlInsertDeleteCells
  23.                     .SaveData = True
  24.                     .AdjustColumnWidth = True
  25.                     .RefreshPeriod = 0
  26.                     .WebSelectionType = xlSpecifiedTables
  27.                     .WebFormatting = xlWebFormattingNone
  28.                     .WebTables = "3"
  29.                     .WebPreFormattedTextToColumns = True
  30.                     .WebConsecutiveDelimitersAsOne = True
  31.                     .Refresh BackgroundQuery:=False
  32.                 End With
  33.                 If E = 1420 Then GoTo xlNext   '加上試試看
  34.                 If InStr(.[A2], "查無") And Msg = True Then GoTo xlNext
  35.                 If InStr(.[A2], "查無") Then Msg = True: GoTo ER
  36.                 If InStr(.[A3], "個股代碼錯誤") = False Then '這網頁如股票代碼錯誤會傳回負號.
  37.                      xFile = xPath & "\" & E & "\REVENUE.txt"
  38.                     MkDir_Sub xFile       '10#的程式 'C槽下的季損益表資料夾不需先建立
  39.                     Maketxt xFile, .QueryTables(1)
  40.                 End If
  41. xlNext:
  42.              Msg = False
  43.             Next
  44.         End With
  45.     End With
  46. End Sub
複製代碼

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
16#
發表於 2014-4-25 13:40 | 顯示全部帖子
回復 25# GBKEE
感謝版主的回覆，看來我只能一個一個把有問題的找出來了，不過照您25#回覆的程式碼，可以簡化一些，感謝幫忙
另外我發現這個擷取資料的VBA最花時間的地方就是在將EXCEL資料一列一列匯入到txt，之前有向您提及我要自己try看看能不能用一次貼上的方式
但try了很多次仍是無法達成，主要在於對程式碼較不了解，比較不清楚怎麼做變化，因為匯入的資料要從1101~9962，資料蠻龐大的，若跑完整個VBA
大約要耗時40分鐘以上，所以才希望能夠讓程式的動作再簡化一些，這應該是最後一次需要做修正了，如果可以的話再請版主多指點一下囉！萬分感謝！
附上您先前提供的程式碼
  1. Sub Maketxt(xF As String, Q As QueryTable)   '將匯入資料存入指定的txt
  2.     Dim fs As Object, E As Range, C As Variant
  3.     Set fs = CreateObject("Scripting.FileSystemObject")
  4.     Set fs = fs.CreateTextFile(xF, True)  '創見一個檔案,如檔案存在可覆蓋掉
  5.     For Each E In Q.ResultRange.Rows
  6.         C = Application.Transpose(Application.Transpose(E.Value))
  7.         C = Join(C, vbTab)
  8.         fs.WriteLine C
  9.     Next
  10.     fs.Close
  11. End Sub
複製代碼
另外25#中的AR及X未定義，我直接將兩個都定義成Variant，就可以順利執行程式了

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
17#
發表於 2014-4-26 11:25 | 顯示全部帖子
回復 27# GBKEE
GBKEE版主您好，今早下班後就開始在Try您在27#回覆的程式碼，結果的確會將一些重覆的個股txt刪除，但不知有沒有辦法將一起建立的資料夾也刪除呢？
舉例來說，1202和2913兩個都是農林，所以程式執行完會將1202的txt刪除，但1202的資料夾仍是存在的，不知沒有沒辦法連資料夾一起刪除呢？
另外還有一個問題，就是這個程式碼保留的資料都是sheet(2)的第二欄個股代號資料，若我沒解讀錯誤的話，程式應該是將個股代碼相同，先抓取的txt刪除，保留後抓取的txt
但就會遇到1233天仁(先抓取)是正確的，4203天仁(後抓取)是錯誤的問題，結果就是正確的1233天仁txt被刪除，這部分我想應該不太好解決
所以，如果可以的話，我還是傾向在您24#回覆的程式碼，用一個一個挑出的方式，這些不需要的代號我都有了，只要輸入AR=Array()中就可以了，只是我要輸入的代號
大概有200個左右，如果全部輸入，如AR=Array(1202,1433,1502,1610.....................)這樣要把200個代碼全部輸入會跳到第二行，然後就會出錯，不知道有沒有辦法
解決這個問題呢？先感謝您的指導！

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
18#
發表於 2014-4-26 14:22 | 顯示全部帖子
回復 27# GBKEE
版主，不好意思，再請教一個問題，現在我要設定迴圈為for E = 1101  9962，但我已經知道某些數字區間是不需要去擷取的，如果想跳過該使用怎樣的語法呢？先謝謝您！
大概的構想如下:
  1. Dim E As Integer
  2.                          For E = 1101 To 2000
  3.                          IF E = 3800到4100 then goto xlNext '想設定某個區間,請教語法該怎麼設
  4.                          IF E = 6850到8000 then goto xlNext '想設定某個區間,請教語法該怎麼設
  5.                          IF E = 8550到9000 then goto xlNext '想設定某個區間,請教語法該怎麼設
  6.                          IF E = 9000到9800 then goto xlNext '想設定某個區間,請教語法該怎麼設,共四個區間

  8. xlNext:         
  9.                          next
  10. End sub
複製代碼

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
19#
發表於 2014-4-26 19:13 | 顯示全部帖子
回復 30# GBKEE
先感謝GBKEE版主一一耐心的回答，因為今晚還要上班，所以您在27#更新的程式碼，可能要等到明天才能try了！
至於電腦減肥部分
1將下面文字複製到記事本  存檔為附檔名 ".BAT",傳送到桌面上 ,不定時的清理垃圾檔案－這個BAT檔我一直都有在用，是否每次執行完VBA就要清一次呢？
2不定時的清空資源回收筒 －最近丟到資源回收筒的資料較多，有空會試一下清空會不會好一點
3 不定時清空IE的瀏覽記錄－平常都是用chorme流灠器為主，不過最近因為要EXCEL匯入WEB資料所以有比較常用，會清空再來試試
4 定時的清理磁碟－兩天前才剛將磁碟重組
5擴充記憶體－我的系統是WIN7 64位元+office 2007，記憶體是4G，不知道這樣有需要擴充嗎？

我有發現會跑那麼久是因為我給的區間越大，程式跑到越後面就越慢，例如我程式碼設定For E = 1101 to 9962，只執行一次，跑起來可能需要40分鐘
但我將程式碼設定For E = 1101 to 3000，For E = 3001 to 5000，For E = 5001 to 7000，For E = 7001 to 9962，共執行四次，合計起來的時間就不需要那麼久
E的區間設定越小，完成的時間就越短，這部分就不太理解為什麼會這樣了！

另外雖然您在27#的程式碼已更新，不過還是希望能了解一下我在28#向您提問的AR=Array(1202,1433,1502,1610.....................)這樣要把200個代碼全部輸入
會跳到第二行，然後就會出錯，不知道有沒有辦法解決這個問題呢？
不知道這個AR的Array區間有沒有辦法輸入200個引數以上呢？

TOP

smart3135

帖子
96 
主題
18 
精華
0 
積分
125 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2014-3-23 
最後登錄
2022-8-2 
20#
發表於 2014-4-26 21:30 | 顯示全部帖子
回復 32# GBKEE
哇 1101到5000跑完只要七分鐘 好威！
我之前也有試過接下引號跳下一行，但一直失敗，原來要跳下一行前接的下引號後面要有空格，又學到一招了，再次感謝您的指導！

TOP

        靜思自在 : 一個人不怕錯，就怕不改過，改過並不難。
123456
返回列表 上一主題