返回列表 上一主題 發帖

[發問] vba 操作ie匯入資料

回復 10# cji3cj6xu6
修改一下 IE不必開開關關
  1. Option Explicit
  2. Sub Ex()
  3.     Dim i As Integer, s As Integer, k As Integer, A, ii, j
  4.     Dim co_id As String, isnew As String, season As String
  5.     Dim DQ As Integer, DQQ As Integer
  6.     With CreateObject("InternetExplorer.Application")
  7.         .Visible = True
  8.         .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
  9.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  10.         DQQ = 6
  11.         For DQ = 1 To 5
  12.             co_id = Sheets(DQQ).Range("A" & DQ).Value
  13.             'Sheets(DQ).Select                  '不必一動工作表
  14.             isnew = 1
  15.             With .document
  16.                 For Each A In .getelementsbytagname("INPUT")
  17.                     If A.Name = "co_id" Then A.Value = co_id
  18.                 Next
  19.                 For Each A In .getelementsbytagname("SELECT")
  20.                     If A.Name = "isnew" Then
  21.                         A.Value = True
  22.                         If isnew = "2" Then
  23.                             A.Focus
  24.                             Application.Wait Now + #12:00:02 AM#
  25.                             Application.SendKeys "{DOWN}"
  26.                             Application.Wait Now + #12:00:02 AM#
  27.                             Application.SendKeys "{ENTER}"
  28.                         End If
  29.                     End If
  30.                     If A.Name = "year" And isnew = "2" Then A.Value = Split(season, ",")(0)
  31.                     If A.Name = "season" And isnew = "2" Then A.Value = Split(season, ",")(1)
  32.                 Next
  33.                 For Each A In .getelementsbytagname("INPUT")
  34.                     If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click        '按下[搜索]鍵
  35.                 Next
  36.             End With
  37.             Application.Wait Now + #12:00:10 AM#                     '等待網頁下載資料
  38.             Set A = .document.getelementsbytagname("table")
  39.             On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
  40.             With Sheets(DQ)            '*** 物件 : 指定工作表  ****
  41.                 .Cells.Clear
  42.            '************************
  43.            ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
  44.            '******************************
  45.                 .[A1] = co_id
  46.                 k = 1
  47.                 For ii = 11 To A.Length - 1        ''從11開始 用 Debug.Print ii  找出所要資料的table範圍
  48.                     For i = 2 To A(ii).Rows.Length - 1      '寫入資料
  49.                         'Debug.Print ii  可找出所要資料的 table 範圍
  50.                         k = k + 1
  51.                         For j = 0 To 5
  52.                             .Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
  53.                         Next
  54.                     Next
  55.                 Next
  56.                 .Range("C2").Cut .Range("D2")
  57.             With .Range("B2:C2,D2:E2")
  58.           '  .Select
  59.                 .HorizontalAlignment = xlCenter
  60.                 .VerticalAlignment = xlCenter
  61.                 .Merge
  62.             End With
  63.             End With
  64.         Next DQ
  65.         .Quit        '關閉網頁
  66.     End With
  67. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

謝謝g大~~

TOP

想再請教一下,
若是a20 的儲存格為中文字"如果",
假設我要判斷a1~a50 的儲存格是否有此一中文字"如果",
當條件發生時,則我的某個數值為B20,否則為c20的儲存格裡的數值。
請問要如何判斷?

謝謝~

TOP

你的B20 , C20都是固定位置嗎?
若是
x = IIf(InStr(Join(Application.Transpose([A1:A50].Value), ""), "如果") > 0, [B20], [C20])
若不是固定位置而是相對於 "如果" 儲存格
問題又怪怪的,沒找到 "如果" 儲存格,哪來的C20

TOP

謝謝stillfish00大的回覆,

您說的沒錯,我寫的不夠清楚。
想再請教一下,
若是在A1 ~ A50裡,A20 的儲存格為"如果",則c55的值為B20,
但若是A21 的儲存格才為"如果",則C55的值為B21
也就是說"如果"不確定是存放在A1 ~A50的哪個地方,
而C55的值也跟著變動,不曉得這樣要如何修改?

繼續思考中~

謝謝!

TOP

回復 15# cji3cj6xu6
  1. Sub TEST()
  2.     Dim f
  3.     With ActiveSheet
  4.         Set f = .[A1:A50].Find(What:="如果", LookIn:=xlValues, LookAt:=xlPart)
  5.         .[C55] = IIf(f Is Nothing, "找不到", f.Offset(, 1).Value)
  6.     End With
  7. End Sub
複製代碼

TOP

回復 15# cji3cj6xu6
更正一下(因為IIF正反都會先運算會有問題)
  1. Sub TEST()
  2.     Dim f
  3.     With ActiveSheet
  4.         Set f = .[A1:A50].Find(What:="如果", LookIn:=xlValues, LookAt:=xlPart)
  5.         If f Is Nothing Then
  6.             .[C55] = "找不到"
  7.         Else
  8.             .[C55] = f.Offset(, 1).Value
  9.         End If
  10.     End With
  11. End Sub
複製代碼

TOP

謝謝stillfish00大的回覆,

這次又可以多學個指令了。
對於vba不熟,只能用些簡單的指令,看來要多學一點了。
通常我只會硬刻一套可用的vba,
比如,這次要是沒有人回覆,我就會用錄製新巨集的方式,
錄下取代"如果"的方法,然後以數字比對的方式來設定C55。

謝謝stillfish00~

TOP

對原作者 至上最高的感寫
我引用原本的code小做修改如下

Sub Ex()
    Dim i As Integer, s As Integer, k As Integer, A, ii, j
    Dim co_id As String, isnew As String, season As String
    Dim input_year As String
    co_id = InputBox("請輸入 公司代號")
    If Not IsNumeric(Val(co_id)) Or Len(co_id) <> 4 Then Exit Sub              '不是四位數的數字
      isnew = "2"
  
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "http://mops.twse.com.tw/mops/web/query6_1"
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        With .document
            For Each A In .getelementsbytagname("INPUT")
                If A.Name = "co_id" Then A.Value = co_id
            Next
            For Each A In .getelementsbytagname("SELECT")
                If A.Name = "isnew" Then
                    A.Value = True
                    If isnew = "2" Then
                        A.Focus
                        Application.Wait Now + #12:00:02 AM#
                        Application.SendKeys "{DOWN}"
                        Application.Wait Now + #12:00:02 AM#
                        Application.SendKeys "{ENTER}"
                    End If
                End If
              If A.Name = "year" And isnew = "2" Then A.Value = "101"
              If A.Name = "month" And isnew = "2" Then A.Value = "05"
  
            Next
            For Each A In .getelementsbytagname("INPUT")
                If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click        '按下[搜索]鍵
            Next
        End With
        Application.Wait Now + #12:00:10 AM#                     '等待網頁下載資料
        Set A = .document.getelementsbytagname("table")
        On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
        With ActiveSheet
            .Cells.Clear
           '************************
           ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
           '******************************
            For ii = 11 To A.Length - 1        ''從11開始 用 Debug.Print ii  找出所要資料的table範圍
                For i = 0 To A(ii).Rows.Length - 1      '寫入資料
                'Debug.Print ii  可找出所要資料的 table 範圍
                k = k + 1
                For j = 0 To 5
                    Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
                Next
            Next
            Next
            .Range("C5").Cut Range("D5")
            With .Range("B5:C5,D5:E5")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Merge
            End With
        End With
        '.Quit        '關閉網頁
    End With
End Sub



我遇到了IE cookie的問題,"年份" 並不會跟著程式碼中定義的"101" 而變更到101
只有紀錄手動差詢過的年份值而作動,例如
C:\Users\user\AppData\Local\Microsoft\Windows\Temporary Internet Files\Cookie:user@mops.twse.com.tw/
內容如下
"D102%"
如果我改成D101% ,在查詢時就可以變成101年,請問VBA有沒有解決方式
我曾經是過用VBA 輸出檔案到這資料夾好像沒有辦法
這個是我測試的程式碼:
Sub XlsToTxT()
Dim MYstr As String, i As Integer                '定義屬性
Open "C:\Users\user\AppData\Local\Microsoft\Windows\Temporary Internet Files\63MX5O7N.txt" For Output As #1     '定義Output File位置
Open "C:\63MX5O7N.txt" For Output As #1     '定義Output File位置
    For i = 1 To 10                                    '由 Row 1to10
        MYstr = Cells(i, 1)                            '輸出的內容 (或你要的東西,可在此開始自己定義吧~)
        Print #1, MYstr
    Next i
Close #1
End Sub

newmops2
co_id%3D5489%7Cyear%3D102%7Cmonth%3D05%7C
mops.twse.com.tw/
1088
3112764800
30318700
2461393296
30318499
*

經過輸出動作後並不會回存為cookie檔案
會真的存成一個TXT檔

TOP

回復 6# lalalada
我也試了一下,發覺用像您同樣的方法先找出參數再QueryTables到Xls的工作表上,比較適合我目前的想法,我習慣以AutoIT自動開啟EXCEL並另存CSV。
很抱歉,我是小學生,不能下載檔案,是個小屁孩!

TOP

        靜思自在 : 【停滯不前,終無所得】人都迷於尋找奇蹟,因而停滯不前;縱使時間再多、路再長,也了無用處,終無所得。
返回列表 上一主題