12345
返回列表 上一主題 發帖

[發問] 如何找出網站原始檔網址

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2014-1-1 16:37 | 只看該作者
回復 10# blue2263
參考這裡
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
12#
發表於 2014-1-2 00:04 | 只看該作者
感謝G大,提供路徑,我找到原始檔網址位置

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
13#
發表於 2014-1-2 00:13 | 只看該作者
可否請G大幫我看一下,以下程式碼,我逐步執行(F8)沒問題,但是改用執行巨集時,都會停在
(Sheets("匯總").Select )出現程式碼的執行己被中斷錯誤訊息,不知那個地方有問題

Sub Macro()
'
' Macro Macro
' 報表整合
'

'
  Application.ScreenUpdating = False '讓視窗不跟隨更新變動
  If ActiveCell.Value <> Empty Then
      Application.CutCopyMode = False
    Selection.Copy
   
                Sheets("原始表").Select
                Range("B2").Select

                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False '貼上
                    
                    On Error GoTo 101 '   '新增條件開始101
                Sheets("原始表").Range("E7").QueryTable.Refresh BackgroundQuery:=False
                Sheets("匯總").Select
                Range("A2:K21").Select
                Selection.Copy
                Range("A1").Select
                Selection.End(xlDown).Select '到最底資料列
                ActiveCell.Offset(1, 0).Range("A1").Select '下一列
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False '貼上值
                     
101
                Sheets("巨集工作表").Select
                ActiveCell.Offset(1, 0).Range("A1").Select
   Call Macro
      End If
       End Sub

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
14#
發表於 2014-1-2 07:55 | 只看該作者
本帖最後由 blue2263 於 2014-1-2 07:57 編輯

G大你好
我後來將程式碼做了下列的更改,就可執行沒問題了
  (Application.ScreenUpdating = False '讓視窗不跟隨更新變動)   去除此行
  Application.Wait (Now + TimeValue("0:00:001"))     '新增此行
   Sheets("匯總").Select

但是為了執行上更快速
我將(讓視窗不跟隨更新變動),此行程式碼加入時,也一樣會有錯誤
請教程式碼要如何更比較好?
麻煩你了感恩謝謝

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2014-1-2 08:27 | 只看該作者
回復 14# blue2263
我將(讓視窗不跟隨更新變動),此行程式碼加入時,也一樣會有錯誤

你沒附檔,莫宰羊.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
16#
發表於 2014-1-2 19:05 | 只看該作者
D股權分散.rar (788.42 KB)
請g大查收圖檔,感恩謝謝

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
17#
發表於 2014-1-3 08:31 | 只看該作者
回復 16# blue2263
  1. Sub Macro()
  2.     Application.ScreenUpdating = False '讓視窗不跟隨更新變動
  3.     If ActiveCell.Value <> Empty Then
  4.         Application.CutCopyMode = False
  5.         Selection.Copy
  6.         Sheets("原始表").Select
  7.         Range("B2").Select
  8.         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  9.             :=False, Transpose:=False '貼上
  10.         On Error GoTo 101 '   '新增條件開始101
  11.         '*********************************************************************
  12.         'ActiveCell.Value應是這Sheets("原始表").Range("E7")QueryTable的股票代號
  13.         '但Sheets("巨集工作表").Select
  14.         'ActiveCell.Offset(1, 0).Range("A1").Select <-沒有股票代號
  15.         'Web的更新會錯誤 一直的 GoTo 101
  16.         Sheets("原始表").Range("E7").QueryTable.Refresh BackgroundQuery:=True
  17.         '*********************************************************************
  18.         'Application.Wait (Now + TimeValue("0:00:02"))
  19.         Sheets("匯總").Select
  20.         Range("A2:K21").Select
  21.         Selection.Copy
  22.         Range("A1").Select
  23.         Selection.End(xlDown).Select '到最底資料列
  24.         ActiveCell.Offset(1, 0).Range("A1").Select '下一列
  25.         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  26.                     :=False, Transpose:=False '貼上值
  27. 101
  28.         Sheets("代碼").Select   '修改這裡試試看
  29.         'Sheets("巨集工作表").Select
  30.         ActiveCell.Offset(1, 0).Range("A1").Select
  31.         Call Macro
  32.     End If
  33. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
18#
發表於 2014-1-3 21:07 | 只看該作者
g大你好,
是將'Sheets("巨集工作表").Select
改為Sheets("代碼").Select 嗎?
我巨集開始執行,是由(巨集工作表)開始的,
改為由代碼開始執行一樣會有,當掉無回應的問題
不好意思還請再幫我看一下謝謝

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
19#
發表於 2014-1-4 08:56 | 只看該作者
本帖最後由 GBKEE 於 2014-1-4 08:57 編輯

回復 18# blue2263
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Rng(1 To 2) As Range
  4.     On Error Resume Next  '執行程式碼如有錯誤繼續執行下一個程式碼: 股票Web有錯誤時
  5.     With Sheets("巨集工作表")
  6.         Set Rng(1) = .Range("B2")
  7.         .Activate
  8.     End With
  9.     'Sheets("匯總").UsedRange.Offset(1).Clear   '用此程式碼" 如需清除舊有資料
  10.     Do While Rng(1) <> ""
  11.         Rng(1).Activate
  12.         With Sheets("原始表")
  13.             .Range("B2") = Rng(1)
  14.             .Range("E7").QueryTable.Refresh BackgroundQuery:=False
  15.             Set Rng(2) = .Range("A10:K29")   '你要的原始資料            
  16.         End With
  17.         If Err = 0 Then
  18.             Application.StatusBar = Rng(1) & " 匯入中"
  19.             With Sheets("匯總").Range("A1").End(xlDown).Offset(1)  
  20.                 .Range("A1:K20").Value = Sheets("匯總").Range("A2:K21").Value
  21.                 Rng(1).Parent.Hyperlinks.Add Anchor:=Rng(1).Offset(, 2), Address:="", SubAddress:=.Address(, , , 1), TextToDisplay:=.Parent.Name & "!" & .Address(0, 0)
  22.                 '重新設定超連結
  23.             End With
  24.             
  25.             '************'用此程式碼:配合需清除舊有資料 ******************************
  26.             'With Sheets("匯總").Range("A" & Sheets("匯總").Rows.Count).End(xlUp).Offset(1)
  27.             '   .Resize(Rng(2).Rows.Count, Rng(2).Columns.Count) = Rng(2).Value
  28.             '    Rng(1).Parent.Hyperlinks.Add Anchor:=Rng(1).Offset(, 2), Address:="", SubAddress:=.Address(, , , 1), TextToDisplay:=.Parent.Name & "!" & .Address(0, 0)
  29.             'End With
  30.             '********************************************
  31.             
  32.         Else
  33.             With Rng(1).Offset(, 2)
  34.                 .Hyperlinks.Delete  '股票Web錯誤:刪除超連結
  35.                 .Value = ""
  36.             End With
  37.             Err.Clear
  38.         End If
  39.         Set Rng(1) = Rng(1).Offset(1)
  40.     Loop
  41.     Application.StatusBar = " 工作 完成 !!"
  42. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

blue2263

帖子
150 
主題
40 
精華
0 
積分
215 
點名
0  
作業系統
windows xp 
軟體版本
sp3 
閱讀權限
20 
註冊時間
2013-7-15 
最後登錄
2024-10-2 
20#
發表於 2014-1-4 13:11 | 只看該作者
本帖最後由 blue2263 於 2014-1-4 13:12 編輯

感謝G大的熱心幫忙
G大我發現有個奇怪現象,
當我在執行巨集當中如果想要,暫停巨集,按下組鍵CTRL+ESC+PAUSE,停止巨集後,->然後再次執行巨集會變成無法自動執行巨集,
都會執行一下後中斷,然後出現,(程式碼的執行己被中斷),必須重開電腦,這現象才會消除
以上測試用G大的程式碼或自己的都會是相同情況,

TOP

        靜思自在 : 好事要提得起，是非要放得下，成就別人即是成就自己。
12345
返回列表 上一主題