做一個屬於自己專屬的風向球指標
版本一
Option Explicit Sub 漲跌家數_Click() Dim URL, xlWorkbookName As String Dim xlYear, xlMonth, xlDay As String Dim i, j, k, l, Days As Integer xlWorkbookName = "漲跌家數.xlsm" With Workbooks(xlWorkbookName).Sheets(1) .UsedRange.ClearContents .Cells(1, 1) = "交易日期" .Cells(1, 2) = "上漲(漲停)" .Cells(1, 3) = "下跌(跌停)" .Cells(1, 4) = "持平" .Cells(1, 5) = "未成交" .Cells(1, 6) = "無比價" .Cells(1, 7) = "總數" End With l = 2 For i = 2013 To Year(Date) For j = 1 To Month(Date) 'Days = DateSerial(i, j + 1, 1) - DateSerial(i, j, 1) Days = Day(DateSerial(i, j + 1, 1) - 1) For k = 1 To Days xlYear = Format(i, "0000") xlMonth = Format(j, "00") xlDay = Format(k, "00") If DateDiff("d", xlYear & "/" & xlMonth & "/" & xlDay, Date) < 0 Then Exit Sub Workbooks(xlWorkbookName).Sheets(2).UsedRange.ClearContents URL = "http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX_print.php?genpage=genpage/Report" & xlYear & xlMonth & "/A112" & xlYear & xlMonth & xlDay & "MS.php&type=csv" With Workbooks.Open(URL) If Not .ActiveSheet.Cells(104, 3).Value = Empty Or _ Not .ActiveSheet.Cells(105, 3).Value = Empty Or _ Not .ActiveSheet.Cells(106, 3).Value = Empty Or _ Not .ActiveSheet.Cells(107, 3).Value = Empty Or _ Not .ActiveSheet.Cells(108, 3).Value = Empty Then .ActiveSheet.Range("C104:C108").Copy Destination:=Workbooks(xlWorkbookName).Sheets(2).Range("A1") End If .Close 0 End With With Workbooks(xlWorkbookName) If Not .Sheets(2).Cells(1, 1).Value = Empty Then .Sheets(1).Cells(l, 1).Value = xlYear & xlMonth & xlDay .Sheets(2).Cells(1, 1) = Split(.Sheets(2).Cells(1, 1), "(")(0) .Sheets(2).Cells(2, 1) = Split(.Sheets(2).Cells(2, 1), "(")(0) .Sheets(2).UsedRange.Copy .Sheets(1).Cells(l, 2).PasteSpecial Transpose:=True .Sheets(1).Cells(l, 7) = Application.Sum(Range(Cells(l, 2), Cells(l, 6))) l = l + 1 End If End With Next k Next j Next i End Sub
執行結果
版本二
Option Explicit Sub 漲跌家數_Click() Dim URL, xlWorkbookName As String Dim xlYear, xlMonth, xlDay As String Dim i, j, k, l, Days As Integer xlWorkbookName = "漲跌家數.xlsm" With Workbooks(xlWorkbookName).Sheets(1) .UsedRange.ClearContents .Cells(1, 1) = "交易日期" .Cells(1, 2) = "上漲(漲停)" .Cells(1, 3) = "下跌(跌停)" .Cells(1, 4) = "持平" .Cells(1, 5) = "未成交" .Cells(1, 6) = "無比價" .Cells(1, 7) = "淨家數" '.Cells(1, 8) = "總數" End With Application.ScreenUpdating = False l = 2 For i = 2013 To Year(Date) For j = 1 To Month(Date) 'Days = DateSerial(i, j + 1, 1) - DateSerial(i, j, 1) Days = Day(DateSerial(i, j + 1, 1) - 1) For k = 1 To Days xlYear = Format(i, "0000") xlMonth = Format(j, "00") xlDay = Format(k, "00") If DateDiff("d", xlYear & "/" & xlMonth & "/" & xlDay, Date) < 0 Then Exit Sub Workbooks(xlWorkbookName).Sheets(2).UsedRange.ClearContents URL = "http://www.twse.com.tw/ch/trading/exchange/MI_INDEX/MI_INDEX_print.php?genpage=genpage/Report" & xlYear & xlMonth & "/A112" & xlYear & xlMonth & xlDay & "MS.php&type=csv" With Workbooks.Open(URL) If Not .ActiveSheet.Cells(104, 3).Value = Empty Or _ Not .ActiveSheet.Cells(105, 3).Value = Empty Or _ Not .ActiveSheet.Cells(106, 3).Value = Empty Or _ Not .ActiveSheet.Cells(107, 3).Value = Empty Or _ Not .ActiveSheet.Cells(108, 3).Value = Empty Then Application.StatusBar = xlYear & "/" & xlMonth & "/" & xlDay & " 資料載入中......" Workbooks(xlWorkbookName).Sheets(1).Cells(l, 2) = Split(.ActiveSheet.Cells(104, 3), "(")(0) Workbooks(xlWorkbookName).Sheets(1).Cells(l, 3) = Split(.ActiveSheet.Cells(105, 3), "(")(0) .ActiveSheet.Range("C106:C108").Copy Workbooks(xlWorkbookName).Sheets(1).Cells(l, 4).PasteSpecial Transpose:=True With Workbooks(xlWorkbookName).Sheets(1) .Cells(l, 1).Value = xlYear & "/" & xlMonth & "/" & xlDay .Cells(l, 7) = .Cells(l, 2) - .Cells(l, 3) '.Cells(l, 8) = Application.Sum(Range(.Cells(l, 2), .Cells(l, 6))) l = l + 1 End With End If .Close 0 End With Next k Next j Next i Application.StatusBar = "資料載入完成......" Application.StatusBar = "" Application.StatusBar = False Application.ScreenUpdating = True End Sub執行結果
沒有留言:
張貼留言