GBKEE

¦^´_ 1# carzyindex
PS: ¤µ¤é(5/1)´ú¸Õ¦¹ºô­¶ ¥u¤¹³\³sÄò¤U¸ü10­¶

1. Sub Ex()
   
2.     Dim ªÑ²¼¥N¸¹ As String, ¤é´Á  As Variant, N, i As Integer
   
3.     Do While Not IsDate(¤é´Á)
   
4.         ¤é´Á = InputBox("¿é¤J¬d¸ß¤é´Á", "¤é´Á", Date)
   
5.         If ¤é´Á = "" Then End
   
6.     Loop
   
7.     Do While ªÑ²¼¥N¸¹ = ""
   
8.         ªÑ²¼¥N¸¹ = InputBox("ªÑ²¼¥N¸¹", "¿é¤J¬d¸ß¤§ªÑ²¼¥N¸¹", "1101")
   
9.         If ¤é´Á = "" Then End
   
10.     Loop
    
11.     ¤é´Á = Format(¤é´Á, "yyyymmdd")
    
12.     With ActiveSheet
    
13.         For Each N In .Names
    
14.             N.Delete
    
15.         Next
    
16.         .Cells.Clear
    
17.         Application.ScreenUpdating = False
    
18.         With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=1", Destination:=Range("A1"))
    
19.             .Name = ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "_1"
    
20.             .FieldNames = True
    
21.             .RowNumbers = False
    
22.             .FillAdjacentFormulas = False
    
23.             .PreserveFormatting = True
    
24.             .RefreshOnFileOpen = False
    
25.             .BackgroundQuery = True
    
26.             .RefreshStyle = xlInsertDeleteCells
    
27.             .SavePassword = False
    
28.             .SaveData = True
    
29.             .AdjustColumnWidth = True
    
30.             .RefreshPeriod = 0
    
31.             .WebSelectionType = xlEntirePage
    
32.             .WebFormatting = xlWebFormattingNone
    
33.             .WebPreFormattedTextToColumns = True
    
34.             .WebConsecutiveDelimitersAsOne = True
    
35.             .WebSingleBlockTextImport = False
    
36.             .WebDisableDateRecognition = False
    
37.             .WebDisableRedirections = False
    
38.             .Refresh BackgroundQuery:=False
    
39.             If Application.CountA(.ResultRange) = 0 Then
    
40.                 MsgBox Format(¤é´Á, "0000/00/00") & " ¥ð¥«!!!  ©Î  ªÑ²¼¥N¸¹:" & ªÑ²¼¥N¸¹ & " ¿ù»~ !!!"
    
41.                 [A1].Select
    
42.                 End
    
43.             End If
    
44.         End With
    
45.         i = 2
    
46.         Do
    
47.             .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
    
48.             With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=" & i, Destination:=Selection)
    
49.                 .Name = ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "_" & i
    
50.                 .WebSelectionType = xlSpecifiedTables
    
51.                 .WebFormatting = xlWebFormattingNone
    
52.                 .WebTables = "6"
    
53.                 .WebPreFormattedTextToColumns = True
    
54.                 .WebConsecutiveDelimitersAsOne = True
    
55.                 .WebSingleBlockTextImport = False
    
56.                 .WebDisableDateRecognition = False
    
57.                 .WebDisableRedirections = False
    
58.                 .Refresh BackgroundQuery:=False
    
59.                 If .ResultRange(1) Like "ip*" Then
    
60.                     .ResultRange.Clear
    
61.                     GoTo Out
    
62.                 End If
    
63.                 i = i + 1
    
64.             End With
    
65.         Loop
    
66. Out:
    
67.         .UsedRange.Columns.AutoFit
    
68.         .[A1].Select
    
69.     End With
    
70.     Application.ScreenUpdating = True
    
71. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 4# carzyindex
½Ð­@¤ßµ¥­Ô  µ{¦¡¦b¶]®É **½Ð¤Å«ö¤U** [½T©w]

'¦¹ºô­¶¦³¤U¸üºÞ¨î ¶·¦³¤U¸ü®É¶¡¶¡¹j 3¬í ¥i¥þ³¡¤U¸ü§¹¦¨
A = CreateObject("WScript.Shell").popup("½Ðµ¥«Ý4¬í«á¤U¸ü" & Chr(10) & Chr(10) & "** ½Ð¤Å«ö¤U ** [½T©w]", 3, ¤é´Á & "_" & .[F2] & "  ²Ä" & i & "­¶", 16 * 3 + 0)

1. Sub ­ÓªÑ¥æ©ö©ú²Ó¤U¸ü()
   
2.     Dim ªÑ²¼¥N¸¹ As String, ¤é´Á As Variant, N, i As Integer, A, T As Date
   
3.     Do While Not IsDate(¤é´Á)
   
4.         ¤é´Á = InputBox("¿é¤J¬d¸ß¤é´Á", "¤é´Á", Date)
   
5.         If ¤é´Á = "" Then End
   
6.     Loop
   
7.     Do While ªÑ²¼¥N¸¹ = ""
   
8.         ªÑ²¼¥N¸¹ = InputBox("ªÑ²¼¥N¸¹", "¿é¤J¬d¸ß¤§ªÑ²¼¥N¸¹", "1101")
   
9.         If ¤é´Á = "" Then End
   
10.     Loop
    
11.     ¤é´Á = Format(¤é´Á, "yyyymmdd")
    
12.     T = Time
    
13.     With ActiveSheet
    
14.         For Each N In .Names
    
15.             N.Delete
    
16.         Next
    
17.         .Cells.Clear
    
18.         Application.StatusBar = False
    
19.         On Error GoTo A_Wait
    
20.         With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=1", Destination:=Range("A1"))
    
21.             .Name = ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "_1"
    
22.             .FieldNames = True
    
23.             .RowNumbers = False
    
24.             .FillAdjacentFormulas = False
    
25.             .PreserveFormatting = True
    
26.             .RefreshOnFileOpen = False
    
27.             .BackgroundQuery = True
    
28.             .RefreshStyle = xlInsertDeleteCells
    
29.             .SavePassword = False
    
30.             .SaveData = True
    
31.             .AdjustColumnWidth = True
    
32.             .RefreshPeriod = 0
    
33.             .WebSelectionType = xlEntirePage
    
34.             .WebFormatting = xlWebFormattingNone
    
35.             .WebPreFormattedTextToColumns = True
    
36.             .WebConsecutiveDelimitersAsOne = True
    
37.             .WebSingleBlockTextImport = False
    
38.             .WebDisableDateRecognition = False
    
39.             .WebDisableRedirections = False
    
40.             .Refresh BackgroundQuery:=False
    
41.             If Application.CountA(.ResultRange) = 0 Then
    
42.                 MsgBox Format(¤é´Á, "0000/00/00") & " ¥ð¥«!!!  ©Î  ªÑ²¼¥N¸¹:" & ªÑ²¼¥N¸¹ & " ¿ù»~ !!!"
    
43.                 [A1].Select
    
44.                 End
    
45.             End If
    
46.         End With
    
47.         i = 2
    
48.         Do
    
49.             .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
    
50.             With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=" & i, Destination:=Selection)
    
51.                 .Name = ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "_" & i
    
52.                 .WebSelectionType = xlSpecifiedTables
    
53.                 .WebFormatting = xlWebFormattingNone
    
54.                 .WebTables = "6"
    
55.                 .WebPreFormattedTextToColumns = True
    
56.                 .WebConsecutiveDelimitersAsOne = True
    
57.                 .WebSingleBlockTextImport = False
    
58.                 .WebDisableDateRecognition = False
    
59.                 .WebDisableRedirections = False
    
60.               ''''''µLªk¬d¸ß®Éµy«Ý  ¨ì  A_Wait: '''''
    
61.                 .Refresh BackgroundQuery:=False
    
62.                 If Application.CountA(.ResultRange) = 0 Then GoTo Out
    
63.                 i = i + 1
    
64.             End With
    
65.             A = CreateObject("WScript.Shell").popup("½Ðµ¥«á¤U¸ü..." & Chr(10) & Chr(10) & "** ½Ð¤Å«ö¤U ** [½T©w]", 4, ¤é´Á & "_" & .[F2] & "  ²Ä" & i & "­¶", 16 * 3 + 0)
    
66.             Application.ScreenUpdating = True
    
67.         Loop
    
68. Out:
    
69.         .UsedRange.Columns.AutoFit
    
70.         .[A1].Select
    
71.         A = CreateObject("WScript.Shell").popup("¦@¤U¸ü" & i & "­¶", 5, ¤é´Á & "_" & ªÑ²¼¥N¸¹, 48 + 0)
    
72.         Application.StatusBar = "¦@¤U¸ü " & i & "­¶ ¶O®É " & Format(Time - T, "HH:MM:SS")
    
73.     End With
    
74.     End
    
75. A_Wait:
    
76.     Application.StatusBar = "µLªk¬d¸ßµ¥­Ô10¬íÄÁ"
    
77.     Application.Wait Now + TimeValue("00:00:10")
    
78.     Err.Clear
    
79.     Application.StatusBar = False
    
80.     Resume    '­«ªð¬d¸ß
    
81. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 7# carzyindex
5¼Óªºµ{¦¡­è¤~´ú¸Õ¬O¦³¨Ç¤£¶¶ ¤wµy¬°­×§ï¤F
²Ä¤@­¶¸ê®Æ¦ì¸m°¾²¾

1. Sub ²©ö©ú²Ó¤U¸ü()
   
2.     Dim ªÑ²¼¥N¸¹ As String, ¤é´Á As Variant, N, i As Integer, A, T As Date
   
3.     Do While Not IsDate(¤é´Á)
   
4.         ¤é´Á = InputBox("¿é¤J¬d¸ß¤é´Á", "¤é´Á", Date)
   
5.         If ¤é´Á = "" Then End
   
6.     Loop
   
7.     Do While ªÑ²¼¥N¸¹ = ""
   
8.         ªÑ²¼¥N¸¹ = InputBox("ªÑ²¼¥N¸¹", "¿é¤J¬d¸ß¤§ªÑ²¼¥N¸¹", "1101")
   
9.         If ¤é´Á = "" Then End
   
10.     Loop
    
11.     ¤é´Á = Format(¤é´Á, "yyyymmdd")
    
12.     T = Time
    
13.     With ActiveSheet
    
14.         For Each N In .Names
    
15.             N.Delete
    
16.         Next
    
17.         .Cells.Clear
    
18.         Application.StatusBar = False
    
19.         On Error GoTo A_Wait
    
20.         i = 1
    
21.         Do
    
22.             .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
    
23.             With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=" & i, Destination:=Selection)
    
24.                 .Name = ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "_" & i
    
25.                 .WebSelectionType = xlSpecifiedTables
    
26.                 .WebFormatting = xlWebFormattingNone
    
27.                 .WebTables = "6"
    
28.                 .WebPreFormattedTextToColumns = True
    
29.                 .WebConsecutiveDelimitersAsOne = True
    
30.                 .WebSingleBlockTextImport = False
    
31.                 .WebDisableDateRecognition = False
    
32.                 .WebDisableRedirections = False
    
33.               ''''''µLªk¬d¸ß®Éµy«Ý  ¨ì  A_Wait: '''''
    
34.                 .Refresh BackgroundQuery:=False
    
35.                 If Application.CountA(.ResultRange) = 0 Then GoTo Out
    
36.                 i = i + 1
    
37.             End With
    
38.             A = CreateObject("WScript.Shell").popup("½Ðµ¥«á¤U¸ü..." & Chr(10) & Chr(10) & "** ½Ð¤Å«ö¤U  [½T©w] **", 4, ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "  ²Ä" & i & "­¶", 16 * 3 + 0)
    
39.             Application.ScreenUpdating = True
    
40.         Loop
    
41. Out:
    
42.         .UsedRange.Columns.AutoFit
    
43.         .[A1].Select
    
44.         A = CreateObject("WScript.Shell").popup("¦@¤U¸ü" & i & "­¶", 5, ¤é´Á & "_" & ªÑ²¼¥N¸¹, 48 + 0)
    
45.         Application.StatusBar = ªÑ²¼¥N¸¹ &" ¦@¤U¸ü " & i & "­¶ ¶O®É " & Format(Time - T, "HH:MM:SS")
    
46.     End With
    
47.     End
    
48. A_Wait:
    
49.     Application.StatusBar = "µLªk¬d¸ßµ¥­Ô5¬íÄÁ"
    
50.     Application.Wait Now + TimeValue("00:00:05")
    
51.     Err.Clear
    
52.     Application.StatusBar = False
    
53.     Resume    '­«ªð¬d¸ß
    
54. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 9# carzyindex
³o¬O¥t¤@»â°ì §Ú¥\¤O¤£°÷ ¤]§ä¤£¥X¨Óªü!

GBKEE

¦^´_ 12# carzyindex
¤U¸ü¤@¤äªÑ²¼­n±Nªñ10¤ÀÄÁ , §Ú¨S´ú¸Õ§¹,½Ð§AºCºC´ú¸Õ .

1. Option Explicit
   
2. Sub ©ú²Ó¤U¸ü()
   
3.     Dim ªÑ²¼¥N¸¹ As Range, ¤é´Á As Variant, i As Integer, A, T As Date
   
4.     Dim Rng As Range
   
5.     Do While Not IsDate(¤é´Á)
   
6.         ¤é´Á = InputBox("¿é¤J¬d¸ß¤é´Á", "¤é´Á", Date)
   
7.         If ¤é´Á = "" Then End
   
8.     Loop
   
9.     ¤é´Á = Format(¤é´Á, "yyyymmdd")
   
10.     Set ªÑ²¼¥N¸¹ = Workbooks("TEST.XLSX").Sheets("sheet2").[A1]
    
11.     Do While ªÑ²¼¥N¸¹.Value <> ""
    
12.         T = Time
    
13.         With Workbooks("TEST.XLSX").Sheets.Add(After:=Sheets(Sheets.Count))
    
14.             .Name = ¤é´Á & "-" & ªÑ²¼¥N¸¹     '³]¥ß ¦b¤u§@ªí¦WºÙ
    
15.             Application.StatusBar = False
    
16.             On Error GoTo A_Wait
    
17.             i = 1
    
18.             Do
    
19.                 Set Rng = .Cells(Rows.Count, 1).End(xlUp).Offset(1)
    
20.                 DoEvents
    
21.                 With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=" & i, Destination:=Rng)
    
22.                     .Name = ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "_" & i
    
23.                     .WebSelectionType = xlSpecifiedTables
    
24.                     .WebFormatting = xlWebFormattingNone
    
25.                     .WebTables = "6"
    
26.                     .WebPreFormattedTextToColumns = True
    
27.                     .WebConsecutiveDelimitersAsOne = True
    
28.                     .WebSingleBlockTextImport = False
    
29.                     .WebDisableDateRecognition = False
    
30.                     .WebDisableRedirections = False
    
31.                 ''''''µLªk¬d¸ß®Éµy«Ý  ¨ì  A_Wait: '''''
    
32.                     .Refresh BackgroundQuery:=False
    
33.                     If Application.CountA(.ResultRange) = 0 Then GoTo Out
    
34.                         i = i + 1
    
35.                 End With
    
36.                 A = CreateObject("WScript.Shell").popup("½Ðµ¥«á¤U¸ü..." & Chr(10) & Chr(10) & "** ½Ð¤Å«ö¤U  [½T©w] **", 4, ¤é´Á & "_" & ªÑ²¼¥N¸¹ & "  ²Ä" & i & "­¶", 16 * 3 + 0)
    
37.                 Application.ScreenUpdating = True
    
38.             Loop
    
39.             
    
40. Out:
    
41.             .UsedRange.Columns.AutoFit
    
42.             ''''''''§R°£ A,FÄ檺ªÅ®æ  ''''''''''''''''''''''''''''''''
    
43.             .Range(.Cells(Rows.Count, "B").End(xlUp).Offset(1), .Cells(Rows.Count, "B")).Offset(, -1).Clear
    
44.             .Range(.Cells(Rows.Count, "G").End(xlUp).Offset(1), .Cells(Rows.Count, "G")).Offset(, -1).Clear
    
45.             '''''''''''''''''''''''''''''''''''''''
    
46.             A = CreateObject("WScript.Shell").popup("¦@¤U¸ü" & i & "­¶", 5, ¤é´Á & "_" & ªÑ²¼¥N¸¹, 48 + 0)
    
47.             Application.StatusBar = ªÑ²¼¥N¸¹ & " ¦@¤U¸ü " & i & "­¶ ¶O®É " & Format(Time - T, "HH:MM:SS")
    
48.         End With
    
49.         Set ªÑ²¼¥N¸¹ = ªÑ²¼¥N¸¹.Offset(1)
    
50.     Loop
    
51.     End
    
52. A_Wait:
    
53.     Application.StatusBar = "µLªk¬d¸ßµ¥­Ô10¬íÄÁ"   'ºô­¶Ác¦£®Éµ{¦¡·|¦³¿ù»~
    
54.     Application.Wait Now + TimeValue("00:00:10")  '¥i¼W¥[µ¥­Ô¬d¸ßªº¬í¼Æ
    
55.     Err.Clear
    
56.     Application.StatusBar = False
    
57.     Resume    '­«ªð¬d¸ß
    
58. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 15# carzyindex
¦³¦¹ºô­¶¦n¿ì¨Ç,¦ý¤U¸üÁÙ¬O«Ü¶O®Éªº,ºCºCªº´ú¸Õ§a!!



´ú¸Õ.rar (17.46 KB)

¤U¸ü¦¸¼Æ: 47

2011-5-17 16:04

GBKEE

¦^´_ 27# gracyei
Sheets(¤é´Á & "-" & ªÑ²¼¥N¸¹).Cells.Clear   

"°õ¦æ¶¥¬q¿ù»~'424':¦¹³B»Ý­nª«¥ó   ¬¡­¶Ã¯¤¤¨S¦³©R¦W¬°¤é´Á & "-" & ªÑ²¼¥N¸¹ ªº¤u§@ªí

¤é´Á & "-" & ªÑ²¼¥N¸¹  ³o¤u§@ªí©Ò¦³Cells(Àx¦s®æ).Clear(²M°£¸ê®Æ)

GBKEE

¦^´_ 29# gracyei
±NÀɮפW¶Ç¬Ý¬Ý

GBKEE

¦^´_ 31# gracyei
­×§ï¦p¤U

1. Option Explicit
   
2. Sub ­ÓªÑ¥æ©ö¾ã­¶()
   
3.     Dim ªÑ²¼¥N¸¹ As Range, ¤é´Á As Variant, F As Range
   
4.     Do While Not IsDate(¤é´Á)
   
5.         ¤é´Á = InputBox("¿é¤J¬d¸ß¤é´Á", "¤é´Á", Date)
   
6.         If ¤é´Á = "" Then End
   
7.     Loop
   
8.     ¤é´Á = Format(¤é´Á, "yyyymmdd")
   
9.     Set ªÑ²¼¥N¸¹ = ThisWorkbook.Sheets("¥N¸¹").[A1]
   
10.     On Error Resume Next                           '¤£²z·| ¦b°õ¦æµ{¦¡ªº®É­Ôµo¥Íªº¿ù»~
    
11.     Do While ªÑ²¼¥N¸¹.Value <> ""
    
12.         ThisWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
    
13.         ActiveSheet.Name = ¤é´Á & "-" & ªÑ²¼¥N¸¹
    
14.         Sheets("¥N¸¹").Activate
    
15.         With Sheets(¤é´Á & "-" & ªÑ²¼¥N¸¹)
    
16.             With .QueryTables.Add(Connection:="URL;http://bsr.twse.com.tw/bshtm/bshtm_report_Messages.aspx?strDate=" & ¤é´Á & "&StartNumber=" & ªÑ²¼¥N¸¹ & "&FocusIndex=All_100", Destination:=.Cells(1))
    
17.                 .Name = ¤é´Á & "-" & ªÑ²¼¥N¸¹
    
18.                 .WebSelectionType = xlEntirePage
    
19.                 .WebFormatting = xlWebFormattingNone
    
20.                 .WebPreFormattedTextToColumns = True
    
21.                 .WebConsecutiveDelimitersAsOne = True
    
22.                 .WebSingleBlockTextImport = False
    
23.                 .WebDisableDateRecognition = False
    
24.                 .WebDisableRedirections = False
    
25.                 Do
    
26.                     DoEvents
    
27.                     Err.Clear                         'Errª«¥óªº­«³]
    
28.                     .Refresh BackgroundQuery:=False   '¬d¸ß¥¢±Ñ ·|²£¥Í¿ù»~
    
29.                 Loop Until Err.Number = 0             '°õ¦æ°j°éª½¨ì¿ù»~®ø:¥¢ ¬d¸ß¦¨¥\
    
30.             End With
    
31.             .Range("F5:H" & Rows.Count).Delete 1
    
32.             .Range(.Cells(.Rows.Count, "B").End(xlUp).Offset(1), .Cells(.Rows.Count, "B")).Offset(, -1).Clear
    
33.             .Range(.Cells(Rows.Count, "G").End(xlUp).Offset(1), .Cells(Rows.Count, "G")).Offset(, -1).Clear
    
34.             Set F = .[A:A].Find("*­¶ / ¦@*", LOOKAT:=xlPart)
    
35.             Do While Not F Is Nothing
    
36.                 F.Offset(-1).Resize(7).EntireRow.Delete
    
37.                 Set F = .[A:A].FindNext
    
38.             Loop
    
39.             .UsedRange.Columns.AutoFit
    
40.         End With
    
41.         Set ªÑ²¼¥N¸¹ = ªÑ²¼¥N¸¹.Offset(1)
    
42.     Loop
    
43.     MsgBox "¤U¸ü§¹²¦ !!!", 32 + 0, "­ÓªÑ¥æ©ö©ú²Ó"
    
44. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 33# sd-jason

¤U¸ü (56.38 KB)

2012-7-6 17:46