返回列表 上一主題 發帖

EXCEL抓取資料問題

回復 1# slip
請將實際的檔案上傳,以便大家能了解你實際的需求面,
謝謝!

TOP

回復 5# slip
已上傳?

TOP

回復 8# register313
回復 7# slip
謝謝 Angela 與 register313 兩位的解說!
J4=TEXT(VLOOKUP("*"&B4&"*",Sheet2!$A$1:$D$100,4,)/100,"0.00%")

TOP

回復 14# slip
目前你權限不足恐怕無法下載,所以我將程式碼貼上,
你複製後將她貼入到 ThisWorkbook 程式區內儲存即可,
至於 Sheet1 某些設定欄位請參照附圖照畫葫即可。
  1. ' DDE 資料紀錄問題
  2. Option Explicit
  3. Dim actEnabled As Boolean
  4. Dim cIndex As Single

  5. Private Sub Workbook_Open()
  6.     ' 以下四列資料之設定,可配合實作、或測試之目的,直接在 "sheet1" 指定之設定欄,得隨時予以異動。
  7.     If (Sheets("sheet1").Range("BA1").Value = "") Then Sheets("sheet1").Range("BA1").Value = "08:45:00"   ' 假設C6欄位為空白,則寫入開盤起始時間
  8.     If (Sheets("sheet1").Range("BA2").Value = "") Then Sheets("sheet1").Range("BA2").Value = "13:45:59"   ' D6欄位亦同。(此兩欄紀錄起始終止時間)
  9.     If (Sheets("sheet1").Range("BB1").Value = "") Then Sheets("sheet1").Range("BB1").Value = "00:01:00"   ' 紀錄資料匯入相隔時間,如每隔一分鐘寫入一次。
  10.     If (Sheets("sheet1").Range("BB2").Value = "") Then Sheets("sheet1").Range("BB2").Value = 0            ' 紀錄已匯入資料列數。

  11.     If (TimeValue(Now) > Sheets("sheet1").Range("BA2").Value) Then       ' 如果目前時間業已超過 D6 的營業時段,則呼叫.......
  12.         Call stopProcedure
  13.     Else                                                                 ' 反之在 D6 設定時間以前,則呼叫.......
  14.         Call startProcedure
  15.     End If
  16. End Sub

  17. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  18.     On Error Resume Next
  19.     Call actStop
  20. End Sub

  21. Sub startProcedure()       ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  22.     Call actStart
  23. End Sub

  24. Sub stopProcedure()        ' 保留作為控制項之應用程序,如按鈕之巨集應用等。
  25.    Call actStop
  26. End Sub

  27. Sub newTitle()
  28.     Sheets(2).[A1].Resize(, 4) = Sheets(1).[A1:D1].Value  ' 套上你欲匯入資料的表頭名稱
  29. End Sub

  30. Sub Starter()
  31.     If (actEnabled = True And TimeValue(Now) >= Sheets("sheet1").Range("BA1").Value And TimeValue(Now) <= Sheets("sheet1").Range("BA2").Value) Then
  32.         cIndex = Sheets("sheet1").Range("BB2").Value

  33.         If (cIndex = 0) Then Call newTitle  ' newTitle 程序 (由使用者自行定義) 是將第一列的資料抬頭名稱寫入到sheet2;如日期、時間的對應欄位資料等。

  34.         Sheets("sheet1").Range("BB2").Value = cIndex + 1       ' 紀錄列號加一。

  35.         ' 複製從券商DDE匯入之相對應位置資料,如 A1、B1、C1、D1 對應的可能是內盤、外盤、成交、漲跌等等,以此類推。
  36.         Sheets(2).[A65536].End(xlUp).Offset(1).Resize(, 4) = Sheets(1).[A2:D2].Value

  37.         cIndex = Sheets("sheet1").Range("BB2").Value      ' 切記 Counter (計數器) 要加一,否則永遠為零 (當然已也可以不予紀錄資料列述,依個人習性)。
  38.     End If
  39. End Sub

  40. Sub onStarter()
  41.     If Not IsError(Sheets(1).[A2]) Then Call Starter
  42.     If actEnabled Then Call actStart
  43. End Sub

  44. Sub actStart()
  45.     actEnabled = True
  46.    
  47.     Application.OnTime (Now + Sheets("sheet1").Range("BB1").Value), "ThisWorkBook.onStarter"     ' 寫入資料的排程 (目前是每隔五分鐘寫入一次)
  48. End Sub

  49. Sub actStop()
  50.     actEnabled = False

  51.     On Error Resume Next
  52.     Application.OnTime Now, "ThisWorkBook.onStarter", , False
  53. End Sub
複製代碼

期貨每分鐘資料匯入.rar (27.93 KB)

TOP

回復  c_c_lai
    再請教c大,我將dde匯入的資料sheet1裡,在5min或10min或隨機?min要把整個2列復製 ...
slip 發表於 2012-5-16 15:44

在5min或10min或隨機?min要把整個2列復製 ...
能否請你描述清楚(明白)一點?

TOP

回復 20# slip
試試看這是不是你的意思:
  1. Sub Test1()
  2.   '  假設你要複製 A2:E2 的即時資訊到M14:Q14 (等5個欄位) 的位置上
  3.    Sheets("Sheet1").[M14].Resize(, 5) = Sheets("Sheet1").[A2:E2].Value
  4. End Sub
複製代碼
如果這是你要的,你就可以增加一按鈕,將其指定巨集指向 Test1。

TOP

回復 22# slip
試試看!
  1. Sub duplicate_Click()
  2.     Dim nextRows As Single
  3.    
  4.     With Sheets("Sheet1")
  5.         nextRows = .Range("A" & Rows.Count).End(xlUp).Row + 1
  6.         .Range("A" & nextRows & ":AH" & .UsedRange.Rows.Count).ClearContents
  7.    
  8.         .Range("A" & nextRows & ":E" & nextRows).Value = Sheets("Sheet1").[A2:E2].Value                ' A-E
  9.         .Range("I" & nextRows & ":AH" & nextRows).Value = Sheets("Sheet1").[I2:AH2].Value              ' I-AH
  10.         .Cells(nextRows, 6).Formula = "=C" & nextRows & "-P" & nextRows                                ' F
  11.         If .Cells(nextRows, 6).Value < 0 Then .Cells(nextRows, 6).Font.Color = 1
  12.         .Cells(nextRows, 7).Formula = "=D" & nextRows & IIf(nextRows = 3, "", "-D" & nextRows - 1)     ' G
  13.         If .Cells(nextRows, 7).Value < 0 Then .Cells(nextRows, 7).Font.Color = 1
  14.         .Cells(nextRows, 8).Formula = "=E" & nextRows & IIf(nextRows = 3, "", "-E" & nextRows - 1)     ' H
  15.         If .Cells(nextRows, 8).Value < 0 Then .Cells(nextRows, 8).Font.Color = 1
  16.     End With
  17. End Sub
複製代碼

TOP

回復 24# slip
因為你無法下載#23的附件,所以無法得知Excel上的增建按鈕的作用,你可以按照以下圖示操作:

當你要擷取資料時只要按那按鈕不是很省事嗎?

TOP

        靜思自在 : 有時當思無時苦,好天要積雨來糧。
返回列表 上一主題