bhsm

回復 10# GBKEE
感謝GBKEE大指導.電腦原使用IE11.移除後.重新安裝IE8.結果正常了.沒出現400的訊息.真是謝謝您了

bhsm

GBKEE大您好:
之前小弟曾承蒙您指教VBA程式， 但現在因小弟希望增加資料，同樣在”常用代碼"的工作表中雙擊股票編號，但不只能帶入”估價"工作表中的殖利率，也希望能帶入”股本”、”股東權益報酬率”、”上市(櫃)時間”， 不知能否請GBKEE大再指導一次，謝謝。 150423.rar (10.62 KB)

下載次數: 11

2015-4-23 13:25

GBKEE

回復 12# bhsm

1. Option Explicit
   
2. Private Sub Worksheet_Calculate()   '估價 [工作表模組]的程式碼
   
3.     If Not Sheet3.Rng Is Nothing Then
   
4.         'Sheet3.Rng       'SheetS("常用代碼")雙擊的處存格
   
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

複製代碼

bhsm

回復 13# GBKEE
感謝GBKEE大,謝謝您

bhsm

回復  bhsm
GBKEE 發表於 2015-4-23 14:48

GBKEE大您好:
我把您教的這個VBA套用在公司的檔案上時，用2003操作都沒問題，但把該檔轉成2010時，操作上卻會發生"執行階段錯誤"28"  堆疊空間不足，當我按下偵錯時，程式會指向
"Sheet28.Rng.Resize(, 4) = Array([L5].Text, [L6].Text, [C14].Text, [B13].Text)"，如果在昨天傳給您的150423.rar檔案轉成2010時，操作沒問題，但套用到公司另外檔案時卻會
發生堆疊空間不足，請問應該修改哪裡來排除問題，謝謝

GBKEE

回復 15# bhsm
堆疊空間不足，Stop 後按下 F8 看看程式如何執行

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

複製代碼

bhsm

回復 16# GBKEE
向GBKEE大回報，
1.雙擊代碼後會出現圖1

下載 (27.18 KB)

2015-4-24 17:14

2.按下F8後出現圖2，此時資料未帶入所需位置

下載 (28.66 KB)

2015-4-24 17:15

3.接著再按一次F8，出現圖3，此時檢視資料都已帶入，但此時須關閉VBA視窗，並停止偵錯，EXCEL才可繼續使用

下載 (29.03 KB)

2015-4-24 17:15

4.重複1.之動作

stillfish00

回復 15# bhsm
個人經驗供參考:
可以檢查你的另外檔案的工作表/活頁簿用到的Event
常見堆疊空間不足的原因"之一"
可能是Event中某些程式碼行為又觸發了其他Event，然後一直不斷循環觸發...

如果是這原因，可在Event事件中適當設定Application.EnableEvents
暫時避免觸發其他event，最後再還原。

bhsm

回復 18# stillfish00
感謝stillfish00大,小弟納悶的是為何EXCEL2003使用上沒問題,但轉成2010時,卻會造成堆疊空間不足,理論上若有程式一直不斷循環觸發,那在2003是不是也應該發生呢?還請您解惑,謝謝

stillfish00

回復 17# bhsm
可以改這樣測測看

1. Private Sub Worksheet_Calculate()
   
2.     Application.EnableEvents = False
   
3.     On Error GoTo EXIT_THIS
   
4.    
   
5.     If
   
6.    
   
7.     ........
   
8.    
   
9.     End If
   
10. 
    
11. EXIT_THIS:
    
12.     If Err.Number > 0 Then
    
13.         MsgBox Err.Description
    
14.         Stop
    
15.         Resume  'F8 goto error line
    
16.     End If
    
17.     Application.EnableEvents = True
    
18. End Sub

複製代碼