GBKEE

¦^´_ 1# bhsm
¸Õ¸Õ¬Ý

[¦ô»ù]¤u§@ªí¼Ò²Õ

1. Private Sub Worksheet_Calculate()
   
2.     Sheet3.Rng = [c5].Text 'SheetS("±`¥Î¥N½X")
   
3. End Sub

½Æ»s¥N½X

[±`¥Î¥N½X]¤u§@ªí¼Ò²Õ

1. Public Rng As Range
   
2. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
3.     If Target.Column = 1 And Target.Row >= 2 And Target <> "" Then
   
4.         Cancel = True
   
5.         Sheets("¦ô»ù").[c1].Value = Target.Value
   
6.         Set Rng = Target.Cells(1, "C")
   
7.     End If
   
8. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 3# bhsm

¤U¸ü (130.07 KB)

2014-8-9 18:01

   
¥u¯d£¸±i[±`¥Î¥N½X] ¤u§@ªí´N¥i¥H

1. Dim Sh As Worksheet
   
2. Sub ¥Dµ{¦¡()
   
3.     Dim Rng As Range, AR(1 To 2) As String, Web_Table(1 To 2), i As Integer, R As Range
   
4.     AR(1) = "URL;https://tw.stock.yahoo.com/q/q?s=xxxx"
   
5.     AR(2) = "URL;https://tw.stock.yahoo.com/d/s/company_xxxx.html"
   
6.     Web_Table(1) = "7"
   
7.     Web_Table(2) = "8"
   
8.     Set Sh = Sheets("±`¥Î¥N½X")
   
9.     Set Rng = Sh.[a2:a27]
   
10.     Rng.Interior.ColorIndex = xlNone
    
11.     Rng.Offset(, 1).Resize(, 4) = ""
    
12.    
    
13.     Web¬d¸ß§R°£
    
14.     Web¬d¸ß»s©w
    
15.     On Error GoTo L2
    
16.    
    
17.     For Each R In Rng
    
18.         For i = 1 To 2
    
19.             With Sh.QueryTables("_" & i)
    
20.                 .Connection = Replace(AR(i), "xxxx", Trim(R))
    
21.                 .WebSelectionType = xlSpecifiedTables
    
22.                 .WebFormatting = xlWebFormattingNone
    
23.                 .WebTables = Web_Table(i)
    
24.                 .WebPreFormattedTextToColumns = True
    
25.                 .WebConsecutiveDelimitersAsOne = True
    
26.                 .WebSingleBlockTextImport = False
    
27.                 .WebDisableDateRecognition = True
    
28.                 .WebDisableRedirections = False
    
29.                 .Refresh BackgroundQuery:=False 'ªÑ¸¹¿ù»~®É·|¦³¿ù»~
    
30.                If i = 1 Then
    
31.                     R.Cells(1, 2) = Mid(.ResultRange.Cells(3, 1), Len(Trim(R)) + 1)
    
32.                     R.Cells(1, 3) = .ResultRange.Cells(3, 3)
    
33.                     R.Cells(1, 3).NumberFormatLocal = "#0.00"
    
34.                Else
    
35.                     R.Cells(1, 4) = .ResultRange(3, 4)
    
36.                End If
    
37.             End With
    
38.         Next
    
39.             R.Cells(1, 5) = Val(R.Cells(1, 4)) / R.Cells(1, 3)
    
40.             R.Cells(1, 5).NumberFormatLocal = "0.00%"
    
41. L1:
    
42.     Next
    
43.    
    
44.     Web¬d¸ß§R°£
    
45.     Exit Sub
    
46. L2:
    
47.     Err.Clear
    
48.     R.Interior.Color = vbYellow
    
49.     GoTo L1
    
50. End Sub
    
51. Private Sub Web¬d¸ß»s©w()
    
52.     Dim i As Integer
    
53.     For i = 1 To 2
    
54.         With Sh.Range("AA" & IIf(i = 1, 1, 50))
    
55.                 With Sh.QueryTables.Add("URL;about:Tabs", .Cells) 'ªÅªººô§}
    
56.                     .Name = "_" & i
    
57.                     .Refresh BackgroundQuery:=False
    
58.                 End With
    
59.             End With
    
60.         Next
    
61. End Sub
    
62. Private Sub Web¬d¸ß§R°£()
    
63.     Dim Q As QueryTable
    
64.     For Each Q In Sh.QueryTables
    
65.         Q.ResultRange.Clear
    
66.         Q.Delete
    
67.     Next
    
68. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# bhsm
1¡B±ÒÀÉ®×(¥X²{¿ù»~°T®§¡A­ì¦]¦p¦ó¡A¯uªº«Ü·Qª¾¹D

¦]¬°·í±`¥Î¥N½X¤u§@ªí ©|¥¼¦³ÂùÀ»A2ªº°Ê§@, ±`¥Î¥N½X¼Ò²Õªº Public Rng As Range ªº RngÅܼÆÁÙ¥¼«ü©wRange
©Ò¥H°õ¦æ¦ô»ù¼Ò²ÕªºWorksheet_Calculateµ{§Ç®É¦³¿ù»~, ¨S¦³³]©wª«¥óÅܼƩΠWith °Ï¶ôÅÜ¼Æ (¿ù»~ 91)
¥i­×§ï¦p¤U

1. Private Sub Worksheet_Calculate()
   
2.     Stop    'Worksheet_Calculateµ{§Ç: ³o¤u§@ªí¤º¤½¦¡ªº­È¦³§ïÅÜ·|°õ¦æ¤@¦¸
   
3.     If Not Sheet3.Rng Is Nothing Then
   
4.         Sheet3.Rng = [c5].Text 'SheetS("±`¥Î¥N½X")
   
5.     End If
   
6. End Sub

½Æ»s¥N½X

´Þ§Q²v1-2.xls 2003Àô¹Ò°õ¦æ«Ü¥¿±`°Ú

GBKEE

¦^´_ 7# bhsm
³o¬O§A©Ò»¡ªº¿ù»~¤º®e

1. ªí³æ¤v¸gÅã¥Ü¡F¤£¯à¦A¥H±j¨î¦^À³ªº¤è¦¡Åã¥Ü¦¹ªí³æ (¿ù»~ 400)
   
2. ±z¤£¯à¥Î Show ¤èªk¡A¥H±j¨î¦^À³ªº¤è¦¡Åã¥Ü¤@­Ó¥i¨£ªºªí³æ¡C³o¶µ¿ù»~ªº­ì¦]¤Î¸Ñ¨M¤èªk¦p¤U¡G
   
3. ±z¸Õ¹Ï¦b¥i¨£ªºªí³æ¤W¡A¨Ï¥Î±N style ¤Þ¼Æ³]©w¦¨ 1 - vbModal ªº Show¡C
   
4. ½Ð¦b¥H±j¨î¦^À³ªº¤è¦¡Åã¥Üªí³æ¤§«e¡A¨Ï¥Î Unload ³¯­z¦¡©Î Hide ¤èªk¡C

½Æ»s¥N½X

½Ð°Ý§A°õ¦æSheet3.¥Dµ{¦¡®ÉÁÙ°õ¦æ¦³¨ä¥Lªºµ{¦¡¶Ü?
³o¬O§Aªº´Þ§Q²v1-2.xls,¨S¦³¿ù»~ 400ªºµo¥Í

Ex.rar (11.54 KB)

¤U¸ü¦¸¼Æ: 24

2014-8-11 05:25

GBKEE

¦^´_ 9# bhsm
·|¬O§AIEªºÃö«Y¶Ü?(¸Õ¸Õ IE­«¦w¸Ë)

GBKEE

¦^´_ 12# bhsm

1. Option Explicit
   
2. Private Sub Worksheet_Calculate()   '¦ô»ù [¤u§@ªí¼Ò²Õ]ªºµ{¦¡½X
   
3.     If Not Sheet3.Rng Is Nothing Then
   
4.         'Sheet3.Rng       'SheetS("±`¥Î¥N½X")ÂùÀ»ªº³B¦s®æ
   
5.       Sheet3.Rng.Resize(, 4) = Array([c5].Text, [F3].Text, [F4].Text, [C8].Text)
   
6.        ' With Sheet3.Rng
   
7.        '    .Cells = [c5].Text
   
8.        '    .Cells(1, "B") = [F3].Text
   
9.        '    .Cells(1, "C") = [F4].Text
   
10.        '    .Cells(1, "D") = [C8].Text
    
11.        ' End With
    
12.     End If
    
13. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 15# bhsm
°ïÅ|ªÅ¶¡¤£¨¬¡AStop «á«ö¤U F8 ¬Ý¬Ýµ{¦¡¦p¦ó°õ¦æ

1. Stop
   
2.       Sheet3.Rng.Resize(, 4).Value = Array([c5].Text, [F3].Text, [F4].Text, [C8].Text)
   
3.       

½Æ»s¥N½X