返回列表 上一主題 發帖

[分享] 大盤每月每天歷史成交量與金額下載

本帖最後由 GBKEE 於 2012-10-19 12:58 編輯

回復 29# usana642
但是按鈕不見了?

EX1.GIF
2012-10-19 12:58



27# 加入程式碼
  1. With .Range("b2", .[b2].End(xlDown))
  2.             .Offset(, -1) = "=rc4 +rc8 + rc9"
  3.             .Columns(5).Replace "-", ""
  4.             .Columns(7) = "=IF(rc[-3]=""Call"",1,0)"    'R1C1表示法 : 工作表上腧入公式
  5.             .Columns(8) = "=IF(rc[-6]=r1c9,1,8)"
  6.             .Columns(9) = "=IF(rc[-2]=1,rc[-3],0)"
  7.             .Columns(10) = "=IF(rc[-3]=0,rc[-4],0)"
  8.             .Columns(11) = "=if(rc[-1]=0,rc[-6]*rc[-5],"""")"
  9.             .Columns(12) = "=if(rc[-2]<>0,rc[-7]*rc[-6],"""")"
  10.              With .Cells(.Rows.Count + 1, 1) '.Rows.Count + 1 範圍內資料總列數+1
  11.                 .Cells(1, 0) = "小計"
  12.                 .Cells(1, 6) = Application.Sum(.Parent.Columns(6))
  13.                 .Cells(1, 9) = Application.Sum(.Parent.Columns(9))
  14.                 .Cells(1, 10) = Application.Sum(.Parent.Columns(10))
  15.                 .Cells(1, 11) = Application.Sum(.Parent.Columns(11))
  16.                 .Cells(1, 12) = Application.Sum(.Parent.Columns(12))
  17.             End With
  18.         End With
複製代碼

TOP

回復 32# usana642
不好意思沒詳細檢查,更正如下
  1. Option Explicit
  2. Private Sub 更新()
  3.     Dim Rng As Range
  4.     With ActiveSheet
  5.         .Cells.Clear
  6.         With .QueryTables.Add("URL;http://www.taifex.com.tw/chinese/3/3_2_2.asp", ActiveSheet.[A1])
  7.             .WebFormatting = xlWebFormattingNone
  8.             .Refresh BackgroundQuery:=False
  9.             ActiveSheet.Names(.Name).Delete
  10.         End With
  11.         .Range("E:G,I:L,N:Q").Delete                                    '刪除多餘的欄
  12.         .Range("1:6,8:8").Delete                                        '刪除多餘的列
  13.         .Range("B1").End(xlDown).Offset(1).Resize(2).EntireRow.Delete   '刪除多餘的列
  14.         .Range("A:A").Insert                                            '插入一欄
  15.         .[B1].Resize(, 12) = Array("契約", "月份", "履約價", "買賣權", "成交價", "未平倉量", "CALL", "=C2", "call-oi", "put-oi", "call-oi$", "put-oi$")
  16.         '**  "=C2" 可修改為 正確的參照  ***
  17.         With .Range("b2", .[b2].End(xlDown))
  18.             .Offset(, -1) = "=rc4 +rc8 + rc9"
  19.             .Columns(5).Replace "-", ""
  20.             .Columns(7) = "=IF(rc[-3]=""Call"",1,0)"    'R1C1表示法 : 工作表上腧入公式
  21.             .Columns(8) = "=IF(rc[-6]=r1c9,1,8)"
  22.             .Columns(9) = "=IF(rc[-2]=1,rc[-3],0)"
  23.             .Columns(10) = "=IF(rc[-3]=0,rc[-4],0)"
  24.             .Columns(11) = "=if(rc[-1]=0,rc[-6]*rc[-5],"""")"
  25.             .Columns(12) = "=if(rc[-2]<>0,rc[-7]*rc[-6],"""")"
  26.         End With
  27.         .UsedRange.Value = .UsedRange.Value             '消除公式
  28.         .Columns.AutoFit
  29.         Set Rng = .Range("b2", .[b2].End(xlDown))
  30.         With Rng
  31.             .Offset(, -1) = "=rc4 +rc8 + rc9"
  32.             .Columns(5).Replace "-", ""
  33.             .Columns(7) = "=IF(rc[-3]=""Call"",1,0)"    'R1C1表示法 : 工作表上腧入公式
  34.             .Columns(8) = "=IF(rc[-6]=r1c9,1,8)"
  35.             .Columns(9) = "=IF(rc[-2]=1,rc[-3],0)"
  36.             .Columns(10) = "=IF(rc[-3]=0,rc[-4],0)"
  37.             .Columns(11) = "=if(rc[-1]=0,rc[-6]*rc[-5],"""")"
  38.             .Columns(12) = "=if(rc[-2]<>0,rc[-7]*rc[-6],"""")"
  39.              With .Cells(.Rows.Count + 1, 1) '.Rows.Count + 1 範圍內資料總列數+1
  40.                 .Cells(1, 0) = "小計"
  41.                 .Cells(1, 6) = Application.Sum(Rng.Columns(6))
  42.                 .Cells(1, 9) = Application.Sum(Rng.Columns(9))
  43.                 .Cells(1, 10) = Application.Sum(Rng.Columns(10))
  44.                 .Cells(1, 11) = Application.Sum(Rng.Columns(11))
  45.                 .Cells(1, 12) = Application.Sum(Rng.Columns(12))
  46.             End With
  47.         End With
  48.     End With
  49. End Sub
複製代碼

TOP

回復 35# c_c_lai
按右鍵

   
EX1.GIF
2012-10-20 07:51

TOP

本帖最後由 GBKEE 於 2012-10-20 08:50 編輯

回復 37# c_c_lai
會是在 [大小及內容] 中嗎?
FormulaR1C1 屬性   傳回或設定物件的公式,用巨集語言的 R1C1 樣式符號表示。Range 物件為讀/寫 Variant,Series 物件為讀/寫 String。
執行後 如圖 勾選 R1C1  便知

EX1.GIF
2012-10-20 08:48
  1. Option Explicit
  2. Sub Ex()
  3.     Dim i
  4.     For i = 1 To 5
  5.         [c5].Cells(1, i) = "=r" & i & "c" & i
  6.         [c5].Cells(2, i) = "=r[" & i & "]c[" & i & "]"
  7.         [c5].Cells(3, i) = "=r[-" & i & "]c[-" & i & "]"
  8.     Next
  9. End Sub
複製代碼

TOP

回復 44# usana642
  1. Option Explicit
  2. Sub 儲存小計結果()
  3.     Dim Rng As Range
  4.     Set Rng = Sheets("計算").Range("G1").End(xlDown)                 'G1往下最後有資料的儲存格
  5.     With Sheets("紀錄").Cells(Rows.Count, "A").End(xlUp).Cells(2, 1)
  6.          'Cells(Rows.Count, "A").End(xlUp):A欄最後列往上有資料的儲存格.Cells(2, 1) :第2列 ,第1欄
  7.           .Value = Date
  8.           .Cells(1, 2) = Rng
  9.           .Cells(1, 3).Resize(1, 4) = Rng.Cells(1, 4).Resize(1, 4).Value
  10.     End With
  11. End Sub
複製代碼

TOP

回復 47# usana642
試試看
  1. Option Explicit
  2. Sub 儲存小計結果()
  3.     Dim Rng(1 To 4) As Range, AR(1 To 6), xi As Integer, e As Variant
  4.     With Sheets("計算")
  5.         Set Rng(1) = .Range("G1").End(xlDown)                 'G1往下最後有資料的儲存格
  6.         Set Rng(2) = .Range("E2", .[E2].End(xlDown))          '買賣權
  7.     End With
  8.     For Each e In Array("Call", "Put")
  9.         Rng(2).Replace e, "=usana642"                          '公式不存在 傳回錯誤值
  10.         With Rng(2).SpecialCells(xlCellTypeFormulas, xlErrors) '有錯誤的儲存格
  11.             With .Offset(, 2)                                  '右移2欄
  12.                 xi = IIf(e = "Call", 0, 1)
  13.                 Set Rng(3) = .Find(Application.Max(.Cells))    '尋找最大值
  14.                 AR(1 + xi) = Rng(3).Offset(, -3)               '履約價
  15.                 AR(3 + xi) = Rng(3).Offset(, -1)               '最後成交價
  16.                 AR(5 + xi) = Rng(3)                            '未沖銷契約量
  17.             End With
  18.             .Value = e
  19.         End With
  20.     Next
  21.     With Sheets("紀錄").Cells(Rows.Count, "A").End(xlUp).Cells(2, 1)
  22.          'Cells(Rows.Count, "A").End(xlUp):A欄最後列往上有資料的儲存格.Cells(2, 1) :第2列 ,第1欄
  23.           .Value = Date
  24.           .Cells(1, 2) = Rng(1)
  25.           .Cells(1, 3).Resize(1, 4) = Rng(1).Cells(1, 4).Resize(1, 4).Value
  26.           .Cells(1, 7).Resize(1, 6) = AR
  27.     End With
  28. End Sub
複製代碼

TOP

回復 51# usana642
[當日-自營商][當日-投信][當日-外資][當日-多空淨額][未平倉-自營商][未平倉-投信][未平倉-外資][未平倉-多空淨額]
這些欄位是抓取  計算1  那些的資料??
.Cells(1, 7).Resize(1, 6) = AR 程式中沒看到抓AR的資料

TOP

回復 54# usana642
重點是
紀錄1工作表 [當日-自營商][當日-投信][當日-外資][當日-多空淨額][未平倉-自營商][未平倉-投信][未平倉-外資][未平倉-多空淨額] 這些欄位
抓取 : 計算1工作表上的那些的資料??
  1. Sub 儲存OI1()
  2. With Sheets("紀錄1").Cells(Rows.Count, "A").End(xlUp).Cells(2, 1)
  3. ' *** Sheets("紀錄1")工作表的 A1須先輸入字串"日期" ******
  4. ' *** 這行程式碼第一次執行才會到正確的位置
  5. 'Cells(Rows.Count, "A").End(xlUp):A欄最後列往上有資料的儲存格.Cells(2, 1) :第2列 ,第1欄
  6. .Resize(1, 9) = Array(Date, 2, 3, 4, 5, Sheets("紀錄1").[F14], [計算1!F14], 8, 9)
  7. 'Date 後面的 2,3,4,5,, 請自行輸入適當的位置
  8. '[計算1!F14] <=> Sheets("紀錄1").[F14] <=> Sheets("紀錄1").Range("F14")
  9. End With
  10. End Sub
複製代碼

TOP

回復 56# 198188
那一網頁可上傳說明,參考看看

TOP

本帖最後由 GBKEE 於 2012-12-3 15:51 編輯

回復 58# 198188
我可以幫你做的只是,vba上的語法及程式上的編寫,你傳上一堆網址,我莫宰羊啦.
重點是要有說明你想做什麼

TOP

        靜思自在 : 對父母要知恩,感恩、報恩。
返回列表 上一主題