ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦¹vba¨«§¹¡A¾ã­Óexcel¦n¹³lag¤F¡A¤£¾å±o¥i¥H«ç¼Ë­×§ï

[µo°Ý] ¦¹vba¨«§¹¡A¾ã­Óexcel¦n¹³lag¤F¡A¤£¾å±o¥i¥H«ç¼Ë­×§ï

Sub GGetPrice()
    Dim DataQ As Integer, DQQ As Integer, DQ As Integer
    Dim StartYear, LastYear, CycleNumber, StockNumber As Integer
   
    StartYear = 2010
    LastYear = 2013
    CycleNumber = 1
    StockNumber = 1101
   
    Sheets("sheet7").Select  '²M°£±ý¦s©ñªº­¶­±
    Cells.Clear
   
    For DP = StartYear To LastYear
   
    Sheets("sheet7").Range("a1").Value = DP
   
   
        For DQ = 9 To 12
            
        Sheets("sheet6").Select        
        Cells.Clear                                '²M°£§ì¨ú¸ê®Æ¦s©ñªº­¶­±

       [b1] = DQ
       [a1] = Sheets("sheet7").Range("a1").Value
      
       If DQ <= 9 Then
        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & [a1] & "0" & [b1] & "/" & [a1] & "0" & [b1] & "_F3_1_8_" & StockNumber & ".php?STK_NO=" & StockNumber & "&myear=" & [a1] & "&mmon=0" & [b1] & "", Destination:=Selection) '·s¼W¬d¸ß
      
        Range("a2").Select
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables         
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8"                                
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        '.Refresh BackgroundQuery:=False
        '.Name = .ResultRange.Cells(1, 1)
        
        '' ¹J¨ì¿ù»~Ä~Äò°õ¦æ
              On Error Resume Next
              '' ºô­¶¿ù»~·|¦b³o¦æ¥á¥X¿ù»~½X¦b Err.Numer ¤¤
              .Refresh BackgroundQuery:=False
              If Err.Number Then
                '' ²M°£¿ù»~°T®§, ¨Ã¥B¦^´_¹w³]ªº¿ù»~³B²zµ{§Ç, Ä~Äò¶]¤U¤@¤Ñªº¸ê®Æ
                Err.Clear
                On Error GoTo 0
         
              End If
              '' ¦^´_¹w³]ªº¿ù»~³B²zµ{§Ç
              On Error GoTo 0

        Worksheets("sheet6").Select
        Range("A4:i30").Select
        Selection.Copy
   
        Data = 3 + (CycleNumber - 1) * 30
        Sheets("sheet7").Select
        Range("a" & Data).Select               
        ActiveSheet.Paste
                  
        CycleNumber = CycleNumber + 1
        
        End With
   
    Else
      
       With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & [a1] & "" & [b1] & "/" & [a1] & "" & [b1] & "_F3_1_8_" & StockNumber & ".php?STK_NO=" & StockNumber & "&myear=" & [a1] & "&mmon=" & [b1] & "", Destination:=Selection)  '·s¼W¬d¸ß
      
         
         Range("a2").Select
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables           
        .WebFormatting = xlWebFormattingNone
        .WebTables = "8"                              
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        '.Refresh BackgroundQuery:=False
        '.Name = .ResultRange.Cells(1, 1)
        
        '' ¹J¨ì¿ù»~Ä~Äò°õ¦æ
              On Error Resume Next
              '' ºô­¶¿ù»~·|¦b³o¦æ¥á¥X¿ù»~½X¦b Err.Numer ¤¤
              .Refresh BackgroundQuery:=False
              If Err.Number Then
                '' ²M°£¿ù»~°T®§, ¨Ã¥B¦^´_¹w³]ªº¿ù»~³B²zµ{§Ç, Ä~Äò¶]¤U¤@¤Ñªº¸ê®Æ
                Err.Clear
                On Error GoTo 0
         
              End If
              '' ¦^´_¹w³]ªº¿ù»~³B²zµ{§Ç
              On Error GoTo 0
                           
        Worksheets("sheet6").Select
        Range("A7:i37").Select
        Selection.Copy
   
        Data = 3 + (CycleNumber - 1) * 30
        Sheets("sheet7").Select
        Range("a" & Data).Select               
        ActiveSheet.Paste
               
        CycleNumber = CycleNumber + 1
      
                 
    End With
    End If
   
   
    Next DQ
    Next DP
    End Sub

¦Ó¬°¤F²M°£¤£¥²­nªº¸ê®Æ¡A¼g¤F¥H¤U¡A¦ý¬åªº«ÜºC¡A¤£¾å±o­n¦p¦ó­×¥¿¡AÁÂÁ¡I

    Sub DeleteLine()
   
    Dim keyword As String
    Dim EndLine As Integer
   
    Sheets("sheet7").Select
   
    keyword = "endword"
    EndLine = 357
   
    Range("a" & EndLine + 1).Value = keyword
    cat = 0
   
    For i = 1 To EndLine
   
     keyword = "¥xªd"                                       '§PÂ_¦³µL¿é¤J¤å¦r
   
    If Range("A" & i).Value Like "*" & keyword & "*" Then
    Rows(i).Delete Shift:=xlUp
    Else
    End If
   
   
    If Range("a" & i).Value <> "(¤¸,ªÑ)" Then
    Else
    Rows(i).Delete Shift:=xlUp
    End If
   
    If Range("a" & i).Value <> "¤é´Á" Then
     Else
    Rows(i).Delete Shift:=xlUp
    End If
   
    For Q = 1 To 9
    If Range("a" & i).Value <> "" Then
     Else
    Rows(i).Delete Shift:=xlUp
    End If
    Next Q
   
    If Range("a" & i).Value <> "endword" Then
   
    Else
    i = EndLine
    End If
      
    'If cat = 1 Then
    'i = i - 1
    'Else
    'End If
   
    Next i
   
    Range("a1").Select
   
End Sub

TOP

§A¥i¯à­n§â½d¨ÒÀɮשñ¤W¨Ó¤j®a¤ñ¸û¦nÆ[¹î§A­nªºµ{§Ç«ü¥O
¤@¶}©l§A²Ä¤@¦¸¶Kªº¨º­ÓÀ³¸Ó¬O¥Î¥¨¶°¿ý»sªº ¤~·|¦³³o»ò¦h¤£»Ý­nªº«ü¥O

If Range("a" & i).Value <> "(¤¸,ªÑ)" Then
    Else
    Rows(i).Delete Shift:=xlUp
    End If

³o¬q§Ú¦³ÂI¤£À´­C  §AªºThen ¨Ã¤£°õ¦æ§PÂ_«á°Ê§@?
§A³o¬qªº·N«ä¤£¬O´Nµ¥©ó

If Range("a" & i).Value <> "(¤¸,ªÑ)" Then
      '­n°µ¤°»ò?
    Else '(¤£µM­n°µ¥H¤U°Ê§@)
    Rows(i).Delete Shift:=xlUp
    End If

TOP

¦^´_ 1# cji3cj6xu6
­×§ï¦p¤U
  1. Option Explicit
  2. Sub GGetPrice()
  3.     Dim StartYear, StockNumber As Integer, URL As String, xlMonth As String, R As Integer, R1 As Integer
  4.     StartYear = 2013
  5.     StartYear = DateSerial(StartYear, 1, 0)     '°_©l¤é=>¥h¦~³Ì«á¤@¤Ñ
  6.     StockNumber = 1101                          'ªÑ²¼¥N¸¹
  7.     Sheets(1).Cells.Clear                       '²M°£±ý¦s©ñªº­¶­±
  8.     On Error Resume Next                      '¥~³¡¬d¸ßªººô§}¦³»~·|¦³¿ù»~(¤é´Á¶W¹L)
  9.     Do While Err.Number = 0
  10.         StartYear = DateAdd("M", 1, StartYear)     '°_©l¤éªº¤U¤@­Ó¤ë¤é´Á
  11.             xlMonth = Format(StartYear, "YYYYMM") & "/" & Format(StartYear, "YYYYMM")
  12.             URL = "URL;http://www.twse.com.tw/ch/trading/exchange/STOCK_DAY/genpage/Report" & xlMonth & "_F3_1_8_" & StockNumber & ".php?STK_NO=" & StockNumber & "&myear=" & Format(StartYear, "YYYY") & "&mmon=" & Format(StartYear, "MM")
  13.             With Sheets(2)                     '²M°£§ì¨ú¸ê®Æ¦s©ñªº­¶­±
  14.                 If .QueryTables.Count = 0 Then
  15.                     With .QueryTables.Add(URL, .[A1])
  16.                         .Refresh BackgroundQuery:=False
  17.                     End With
  18.                 End If
  19.                 With .QueryTables(1)
  20.                     .Connection = URL
  21.                     .WebSelectionType = xlSpecifiedTables
  22.                     .WebFormatting = xlWebFormattingNone
  23.                     .WebTables = "8"
  24.                     .WebPreFormattedTextToColumns = False
  25.                     .WebConsecutiveDelimitersAsOne = False
  26.                     .WebSingleBlockTextImport = False
  27.                     .WebDisableDateRecognition = True
  28.                     .WebDisableRedirections = True
  29.                     .Refresh BackgroundQuery:=False
  30.                      With .ResultRange
  31.                         R = Application.CountA(Sheets(1).[A:A])
  32.                         R1 = IIf(R = 0, 3, 4)
  33.                         .Rows(R1).Resize(.Rows.Count - R1 + 1).Copy Sheets(1).Cells(R + 1, 1)
  34.                      End With
  35.             End With
  36.          End With
  37.        Loop
  38.        Sheets(1).Columns.AutoFit
  39.        MsgBox "OK!"
  40. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

ÁÂÁÂhandsometrowa¤jªºÃö¤ß¡A¥¿­npo ¤W¨Ó¡A
¨S®Æ¨ìµ½¸Ñ¤H·NªºGBKEE¤j¤w±N¤p§Ìªº°ÝÃD¤@¨Ö¥þ¸Ñ¤F¡A
¦hÁ¨â¦ì¡ã

¦ýGBKEE¤j¡A½Ð°Ý¤@¤U¡A¤WÂdªº¸ê®Æ­n«ç¼Ë¼g¶i¨Ó¡CÁÂÁ¡I

TOP

¦^´_ 5# cji3cj6xu6
¤ñ¹ï¤W¥«,¤WÂdªººô§},¨Ì¼Ëµe¸¬Äª,¸Õ¸Õ¬Ý.
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

http://www.otc.org.tw/ch/stock/aftertrading/daily_trading_info/st43.php
¦ý¤WÂdªººô§}¦³²§¡A­n¿é¤J¦~¤ë¤é ¡® ¥N¸¹¡AµM«á«ö¤U¬d¸ß¡C
§Ú¦A¨Ó·Q·Q¬Ý

TOP

        ÀR«ä¦Û¦b : ¬°¤H³B¥@­n¤p¤ß²Ó¤ß¡A¦ý¤£­n¡u¤p¤ß²´¡v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD