GBKEE

¦^´_ 38# chang0833
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim URL As String, xCo_Id As String, X As Integer
   
4.     Dim xSyear As Integer, xSseason As Integer, Ar(1 To 4)
   
5.     Dim Sh(1 To 2) As Worksheet, AY, Rng As Range, E As Variant
   
6.     Dim Wb As Workbook
   
7.     For X = 0 To 3
   
8.         Ar(X + 1) = 1 + (6 * X)  '²Ä¤@©u¨ì²Ä¥|©uªºÄæ¦ì
   
9.     Next
   
10.     xCo_Id = Application.InputBox("½Ð¿é¤JªÑ²¼¥N¸¹", , 2303)         '¹w³]¬° 2303
    
11.     X = Year(Date) - 1910                 '¤¤µØ¥Á°êªº¦~«×
    
12.     Application.ScreenUpdating = False
    
13.     Set Wb = Workbooks("book1.xls")           '«ü©w¬¡­¶Ã¯
    
14.     With Wb
    
15.         Set Sh(1) = .Sheets.Add               '·s¼W¤u§@ªí: ½Æ»s©u°]³ø¨ì«ü©w¤u§@­¶
    
16.         Set Sh(2) = .Sheets.Add               '·s¼W¤u§@ªí:  WEB¬d¸ß¥Î
    
17.     End With
    
18.     On Error GoTo Er                        '³B²zµ{¦¡¤Wªº¿ù»~
    
19.     Sh(1).Name = xCo_Id & "©u³øªí"          '³o¦WºÙ¤u§@ªí¦p¤w¦s¦bµ{¦¡·|¦³¿ù»~
    
20.     On Error GoTo 0                         '¤£¦b³B²zµ{¦¡¤Wªº¿ù»~
    
21.    
    
22.     For xSyear = X To X - 3 Step -1        '°j°é:¦~«×    '105->102
    
23.     'For xSyear = X - 3 To X               '°j°é:¦~«×    '102->105
    
24.         For xSseason = 1 To 4 '             '°j°é:©u§O    '1,2,3,4
    
25.             URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    
26.             With Sh(2).QueryTables.Add(Connection:=URL, Destination:=Sh(2).[A1])
    
27.                 .Name = xCo_Id & "_" & xSyear & "_²Ä" & xSseason & "©u" 'WEB¬d¸ßªº¦WºÙ
    
28.                 .AdjustColumnWidth = True                  '¦Û°Ê½Õ¾ãÄæ¼e
    
29.                 .WebSelectionType = xlSpecifiedTables
    
30.                 .WebFormatting = xlWebFormattingNone
    
31.                 .WebTables = "2,3,4"                  '¸ê²£­t¶Åªí,ºî¦X·l¯qªí,²{ª÷¬y¶qªí
    
32.                 .WebPreFormattedTextToColumns = True
    
33.                 .WebConsecutiveDelimitersAsOne = True
    
34.                 .WebSingleBlockTextImport = False
    
35.                 .WebDisableDateRecognition = False
    
36.                 .WebDisableRedirections = False
    
37.                 .Refresh BackgroundQuery:=False
    
38.                 If .ResultRange.Rows.Count > 2 Then '¦³¸ê®Æ
    
39.                     Set Rng = Sh(1).Cells(1, Ar(xSseason)).Cells(Rows.Count).End(xlUp)
    
40.                     If Rng.Row > 1 Then Set Rng = Rng.Offset(2)
    
41.                     .ResultRange.Copy Rng
    
42.                 Else
    
43.                     .Delete
    
44.                 End If
    
45.                
    
46.             End With
    
47.         Next
    
48.     Next
    
49.     Application.DisplayAlerts = False
    
50.     Sh(2).Delete
    
51.     Application.DisplayAlerts = True
    
52.     Application.ScreenUpdating = True
    
53.     Sh(1).Parent.Save
    
54.     MsgBox "Ok"
    
55.     Exit Sub
    
56. Er:     '³B²z xCo_Id &©u³øªí ¤u§@ªí¤w¦s¦b
    
57.     Application.DisplayAlerts = False
    
58.     Sheets(xCo_Id & "©u³øªí").Delete
    
59.     Application.DisplayAlerts = True
    
60.    Resume Next  '¦^¨ì¿ù»~ªºµ{¦¡½X
    
61. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 40# chang0833

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Wb As Workbook
   
4.     Set Wb = ActiveWorkbook                         '§@¥Î¤¤¬¡­¶Ã¯
   
5.     Set Wb = ThisWorkbook                           'µ{¦¡½X©Ò¦bªº¬¡­¶Ã¯
   
6.     Set Wb = Workbooks("book1")                     '¤w¶}±Ò¤Fªº¬¡­¶Ã¯¤¤,«ü©wªº¬¡­¶Ã¯
   
7.     Set Wb = Workbooks.Open("D:\¸Õºâªí\Book1.xls")  '­n¶}±Òªº¬¡­¶Ã¯
   
8.    
   
9.     Set Wb = Workbooks("Book1.xls")                 '¤w¶}±Ò¤Fªº¬¡­¶Ã¯¤¤,«ü©wªº¬¡­¶Ã¯
   
10.    
    
11. End Sub

½Æ»s¥N½X

¤U¸ü (98.31 KB)

2015-11-17 07:02

GBKEE

¦^´_ 42# chang0833
¬O³o¼Ë¶Ü?

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim URL As String, xCo_Id As String
   
4.     Dim xSyear As Integer, xSseason As Integer
   
5.     Dim Sh(1 To 2) As Worksheet, Rng As Range
   
6.    
   
7.     xCo_Id = Application.InputBox("½Ð¿é¤JªÑ²¼¥N¸¹", , 2303)         '¹w³]¬° 2303
   
8.     xSyear = Format(Date, "E")                 '¤¤µØ¥Á°êªº¦~«×
   
9.     xSseason = DatePart("q", Date)             '·í©u
   
10.     Application.ScreenUpdating = False
    
11.     'Set Wb = ThisWorkbook           '«ü©w¬¡­¶Ã¯
    
12.     With ThisWorkbook           '«ü©w¬¡­¶Ã¯
    
13.         Set Sh(1) = .Sheets.Add               '·s¼W¤u§@ªí: ½Æ»s©u°]³ø¨ì«ü©w¤u§@­¶
    
14.         Set Sh(2) = .Sheets.Add               '·s¼W¤u§@ªí:  WEB¬d¸ß¥Î
    
15.     End With
    
16.     On Error GoTo Er                        '³B²zµ{¦¡¤Wªº¿ù»~
    
17.     Application.DisplayAlerts = False
    
18.     Sh(1).Name = xCo_Id & "©u³øªí"          '³o¦WºÙ¤u§@ªí¦p¤w¦s¦bµ{¦¡·|¦³¿ù»~
    
19.     Set Rng = Sh(1).[A1]
    
20.     On Error GoTo 0                         '¤£¦A³B²zµ{¦¡¤Wªº¿ù»~
    
21.    
    
22.     Do
    
23.             URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    
24.             With Sh(2).QueryTables.Add(Connection:=URL, Destination:=Sh(2).[A1])
    
25.                 .Name = xCo_Id & "_" & xSyear & "_²Ä" & xSseason & "©u" 'WEB¬d¸ßªº¦WºÙ
    
26.                 .AdjustColumnWidth = True                  '¦Û°Ê½Õ¾ãÄæ¼e
    
27.                 .WebSelectionType = xlSpecifiedTables
    
28.                 .WebFormatting = xlWebFormattingNone
    
29.                 .WebTables = "2,3,4"                  '¸ê²£­t¶Åªí,ºî¦X·l¯qªí,²{ª÷¬y¶qªí
    
30.                 .WebPreFormattedTextToColumns = True
    
31.                 .WebConsecutiveDelimitersAsOne = True
    
32.                 .WebSingleBlockTextImport = False
    
33.                 .WebDisableDateRecognition = False
    
34.                 .WebDisableRedirections = False
    
35.                 .Refresh BackgroundQuery:=False
    
36.                 If .ResultRange.Rows.Count > 2 Then '¦³¸ê®Æ
    
37.                     Debug.Print xSyear, xSseason, Rng.Address
    
38.                     .ResultRange.Copy Rng
    
39.                      Set Rng = Rng.Offset(, .ResultRange.Columns.Count + 1)
    
40.                 Else
    
41.                     .Delete
    
42.                 End If
    
43.             End With
    
44.             xSseason = xSseason - 1
    
45.             If xSseason = 0 Then
    
46.                 xSseason = 4
    
47.                 xSyear = xSyear - 1
    
48.             End If
    
49.     Loop Until xSyear = Format(Date, "E") - 3
    
50.    
    
51.     Sh(2).Delete
    
52.     Application.DisplayAlerts = True
    
53.     Application.ScreenUpdating = True
    
54. '   Sh(1).Parent.Save
    
55.     MsgBox "Ok"
    
56.     Exit Sub
    
57. Er:     '³B²z xCo_Id &©u³øªí ¤u§@ªí¤w¦s¦b
    
58.     Sheets(xCo_Id & "©u³øªí").Delete 'Âл\­ì¤u§@­¶¶Ü¡H(¥u¯d¤U³Ì«á§ó·sªº¸ê®Æ)
    
59.    
    
60.     Resume     '¦^¨ì¿ù»~ªºµ{¦¡½X
    
61. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 47# jasonwu0114
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim URL As String, xCo_Id As Range, xSyear As String, xSseason As String, i As Integer, M As Variant
   
4.     xSyear = 105
   
5.     xSseason = 3
   
6.     For i = 1 To 20  '¶]20-30­ÓªÑ²¼¥N¸¹
   
7.         Set xCo_Id = Sheets(1).Cells(i, "A")  'ªÑ²¼¥N¸¹
   
8.         URL = "URL;http://mops.twse.com.tw/server-java/t164sb01?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
   
9.         With SheetS(2).QueryTables.Add(Connection:=URL, Destination:=Sheets(2).Range("A1"))
   
10.             .AdjustColumnWidth = False                   '¦Û°Ê½Õ¾ãÄæ¼e
    
11.             .WebSelectionType = xlSpecifiedTables
    
12.             .WebFormatting = xlWebFormattingNone
    
13.             .WebTables = "2"   ',3,4"                 '¸ê²£­t¶Åªí,ºî¦X·l¯qªí,²{ª÷¬y¶qªí
    
14.             .WebPreFormattedTextToColumns = True
    
15.             .WebConsecutiveDelimitersAsOne = True
    
16.             .WebSingleBlockTextImport = False
    
17.             .WebDisableDateRecognition = False
    
18.             .WebDisableRedirections = False
    
19.             .Refresh BackgroundQuery:=False
    
20.             With .ResultRange  '©Ò¶×¤J¸ê®Æªº½d³ò
    
21.                 M = Application.Match("*À³¥Iµu´Á²¼¨é¦X­p", .Columns(1), 0)  '¤u§@ªí¨ç¼Æ¦b²Ä¤@Ä椤¶Ç¦^¤ñ¹ï¨ìªºÄæ¦ì
    
22.                 If IsNumeric(M) Then xCo_Id.Offset(, 1) = .Cells(M, "b")             '¦³¤ñ¹ï¨ì¶Ç¦^ªºÄæ¦ìªº¼Æ¦r
    
23.                 .Clear
    
24.             End With
    
25.             .Parent.Names(.Name).Delete          '§R°£¤u§@ªíªº¦WºÙ
    
26.             .Delete                                             ''³oQueryTable§R°£±¼
    
27.         End With
    
28.     Next
    
29. End Sub

½Æ»s¥N½X