- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2012-1-6 14:00
| 只看該作者
回復 3# peter460191
須複製到 Sheet1- Option Explicit
- Private Sub Worksheet_Change(ByVal Target As Range)
- Application.EnableEvents = False 'False 指定物件不能觸發事件
- 'EnableEvents 屬性 如果指定物件能觸發事件,則本屬性為 True
- If Not Intersect(Target(1), Range([A6], [A6].End(xlDown))) Is Nothing Then Ex Target(1)
- 'Intersect 方法 傳回 Range 物件,此物件代表兩個或多個範圍重疊的矩形範圍。
- Application.EnableEvents = True 'True 指定物件能觸發事件
- End Sub
- Private Sub Ex(E As Range) '接受參數 E As Range
- Dim Ar()
- With Sheets("Sheet2").[A1].QueryTable ' ***Sheet2").[A1] 請設有外部查詢***
- .Connection = "URL;http://justdata.yuanta.com.tw/z/zc/zcc/zcc_" & E & ".asp.htm"
- .WebSelectionType = xlSpecifiedTables
- .WebFormatting = xlWebFormattingNone
- .WebTables = "4"
- .WebPreFormattedTextToColumns = True
- .WebConsecutiveDelimitersAsOne = True
- .WebSingleBlockTextImport = False
- .WebDisableDateRecognition = False
- .WebDisableRedirections = False
- .Refresh BackgroundQuery:=False
- With .ResultRange
- Ar = .Range(.Cells(2, 6), .Cells(6, 6)).Value '年度股利合計範圍
- End With
- End With
- E.Offset(, 2).Resize(1, 5) = Application.Transpose(Ar) '年度股利合計 複製於 股票代號區域向右2欄(1列,5欄)
- '這裡 Sheets("Sheet1")有輸入: 會觸動Sheets("Sheet1")的 Private Sub Worksheet_Change
- 'Application.EnableEvents = False -> 不會觸發Sheets("Sheet1")的 Private Sub Worksheet_Change
- End Sub
複製代碼 |
|