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

Excel VBA§ì¨úªÑ²¼¸ê®Æ

Excel VBA§ì¨úªÑ²¼¸ê®Æ

VBAµ{¦¡½X¦p¤U
view source
print?
001        Option Explicit
002         
003        'ªÑ²¼Ãþ§O
004        '01 ¤ôªd¤u·~
005        '02 ­¹«~¤u·~
006        '03 ¶ì½¦¤u·~
007        '04 ¯¼Â´ÅÖºû
008        '05 ¹q¾÷¾÷±ñ
009        '06 ¹q¾¹¹qÆl
010        '07 ¤Æ¾Ç¥Í§ÞÂåÀø
011        '08 ¬Á¼þ³³²¡
012        '09 ³y¯È¤u·~
013        '10 ¿ûÅK¤u·~
014        '11 ¾ó½¦¤u·~
015        '12 ¨T¨®¤u·~
016        '13 ¹q¤l¤u·~
017        '14 «Ø§÷Àç³y
018        '15 ¯è¹B·~
019        '16 Æ[¥ú¨Æ·~
020        '17 ª÷¿Ä«OÀI·~
021        '18 ª÷¿Ä«OÀI·~
022        '19 ºî¦X¥ø·~
023        '20 ¨ä¥L
024        '21 ¤Æ¾Ç¤u·~
025        '22 ¥Í§ÞÂåÀø·~
026        '23 ªo¹q¿U®ð·~
027        '24 ¥b¾ÉÅé·~
028        '25 ¹q¸£¤Î¶gÃä³]³Æ·~
029        '26 ¥ú¹q·~
030        '27 ³q«Hºô¸ô·~
031        '28 ¹q¤l¹s²Õ¥ó·~
032        '29 ¹q¤l³q¸ô·~
033        '30 ¸ê°TªA°È·~
034        '31 ¨ä¥L¹q¤l·~
035         
036        Dim Tempsheet As Excel.Worksheet
037         
038        Private Sub §ó·sªÑ²¼¸ê®Æ_Click()
039            §ì¨úªÑ²¼°ò¥»¸ê®Æ
040        End Sub
041         
042        Sub §ì¨úªÑ²¼°ò¥»¸ê®Æ()
043            Dim n As Integer
044            Dim StartTime
045             
046            StartTime = Now
047         
048            If ½T»{¤u§@ªí¦s¦b("Temp") <> True Then
049                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Temp"
050            End If
051             
052            ²M°£¤u§@ªí ("Sheet1")
053            ²M°£¤u§@ªí ("Temp")
054             
055            Application.ScreenUpdating = False
056             
057            Set Tempsheet = Sheets("Temp")
058             
059            If ¨ú±oªÑ²¼¸ê®Æ = 0 Then
060                MsgBox "µLªk§ì¨úªÑ²¼¸ê®Æ"
061                Exit Sub
062            End If
063          
064            Application.StatusBar = "¥¿¦bÂà´«¸ê®Æ¡A½Ðµy«á......"
065             
066            With Sheet1
067                .Cells(1, 1) = "ªÑ²¼¥N½X"
068                .Cells(1, 2) = "¤½¥q¦WºÙ"
069                
070                n = ¨ú±o¤½¥q¶¡¼Æ
071                Tempsheet.Range("A1:B" & n).Copy    '¥Ø«e¥u¦C¥XªÑ²¼¥N½X¡B¤½¥q¦WºÙ¡A¦p¦³»Ý­n¨ä¥LÄæ¦ì¡A½Ð¦Û¦æÅܧó
072             
073                .Cells(2, 1).Select
074                .Paste
075            End With
076             
077            Application.StatusBar = "ªÑ²¼°ò¥»¸ê®Æ§ì¨ú§¹¦¨"
078            Application.ScreenUpdating = True
079             
080            MsgBox "ªÑ²¼°ò¥»¸ê®Æ¤U¸ü ¦@ªá¶O " & Format(Now - StartTime, "HH®Émm¤Àss¬í") & " ¤U¸ü§¹¦¨¡C" & vbCrLf & "¥H¬í­pºâ ¦@ªá¶O " & DateDiff("s", StartTime, Now) & " ¬í¤U¸ü§¹¦¨", vbInformation
081         
082        End Sub
083         
084        Sub ²M°£¤u§@ªí(xlWSName As String)
085            Dim qyt As QueryTable
086            With Worksheets(xlWSName)
087                For Each qyt In .QueryTables
088                    qyt.Delete
089                Next
090             
091                .Cells.Clear
092                .Cells.ClearContents
093            End With
094        End Sub
095         
096        Function ¨ú±o¤½¥q¶¡¼Æ()
097            Dim i As Integer, j As Integer, n As Integer
098            j = 0
099            ¨ú±o¤½¥q¶¡¼Æ = 0
100            With Tempsheet
101                n = .Cells(65536, 1).End(xlUp).Row
102                For i = 1 To n
103                    If .Cells(i, 1).Value = Empty Or _
104                       .Cells(i, 1).Value = "¥N¸¹" Or _
105                       .Cells(i, 1).Value = "¤½¥q" Then
106                        j = j + 1
107                        .Rows(i & ":" & i).Delete Shift:=xlUp
108                        If n - j >= i Then
109                            i = i - 1
110                        End If
111                     End If
112                Next
113                ¨ú±o¤½¥q¶¡¼Æ = .Cells(65536, 1).End(xlUp).Row
114            End With
115        End Function
116         
117        Function ¨ú±oªÑ²¼¸ê®Æ()
118            Dim xlURL As String
119             
120            Application.StatusBar = "±qWeb¨ú±oªÑ²¼¸ê®Æ¤¤¡A½Ðµy«á......"
121             
122            xlURL = "http://mops.twse.com.tw/mops/web/ajax_t51sb01?step=1&firstin=1&TYPEK=sii" '¤W¥« sii, ¤WÂd otc
123            With Tempsheet.QueryTables.Add("URL;" & xlURL, Tempsheet.Cells(1, 1))
124                .WebFormatting = xlWebFormattingNone
125                .WebTables = "2"
126                .Refresh 0
127                If Application.Count(.ResultRange) = 0 Then
128                    ¨ú±oªÑ²¼¸ê®Æ = 0
129                    Exit Function
130                End If
131                ¨ú±oªÑ²¼¸ê®Æ = Application.Count(.ResultRange)
132                .Delete
133            End With
134        End Function
135         
136        Function ½T»{¤u§@ªí¦s¦b(xlWSName As String) As Boolean
137            On Error Resume Next
138            Dim xlTemp As Excel.Worksheet
139             
140            Set xlTemp = Worksheets(xlWSName)
141            If Not xlTemp Is Nothing Then
142                ½T»{¤u§@ªí¦s¦b = True
143                On Error GoTo 0
144                Set xlTemp = Nothing
145                Exit Function
146            End If
147             
148            ½T»{¤u§@ªí¦s¦b = False
149            On Error GoTo 0
150            Set xlTemp = Nothing
151        End Function

³ø§ielufa¡A¤£¯à°õ¦æ¡A¦³«Ü¦h«ü¥O©MªÅ¥Õ·|¥d¦í

TOP

        ÀR«ä¦Û¦b : ¤f»¡¤@¥y¦n¸Ü¡A¦p¤f¥X½¬ªá¡F¤f»¡¤@¥yÃa¸Ü¦p¤f¦R¬r³D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD