麻辣家族討論版版 - Powered by Discuz! Board

標題: 避免重複執行程式 [打印本頁]

作者: myleoyes 時間: 2010-12-20 11:43 標題: 避免重複執行程式

各位前輩你們好!
前輩!問題如附檔說明
請知道的前輩,不吝賜教謝謝再三!!

作者: GBKEE 時間: 2010-12-20 20:52

回復 1# myleoyes
但須在此作改變請按鈕9A,這就是問題所在???
可以述說你要的是什麼嗎?

作者: luhpro 時間: 2010-12-20 21:52

回復 1# myleoyes
以下是你所提供的部分程式 :
Sub HA()
Range("H3:H152") = ""
Range("H4").FormulaR1C1 = "=SUM(R[-1]C*R[-1]C[-4],R[-1]C,RC[-1])"
Range("H4").AutoFill Destination:=Range("H4:H" & [A152].End(3).Row), Type:=xlFillDefault
Range("H3").Select
Range("H:H").EntireColumn.AutoFit
End Sub
Sub MA()
Range("M3:M152") = ""
Range("M3").FormulaR1C1 = "=RC[-8]"
Range("M4").FormulaR1C1 = "=SUM(R[-1]C*RC[-9],R[-1]C,R3C13)"
Range("M4").AutoFill Destination:=Range("M4:M" & [c1526].End(3).Row), Type:=xlFillDefault
ActiveCell.Select
[M3].End(xlDown)(2, 1).FormulaR1C1 = "=SUM(R[-1]C*RC[-9],R[-1]C)"
R = [M152].End(xlUp).Row
S = "M" & R & ":M" & [A152].End(xlUp).Row
Range("M" & R).AutoFill Destination:=Range(S), Type:=xlFillDefault
Range("M3").Select
Range("M:M").EntireColumn.AutoFit
End Sub

目前僅看出 H3 之所以會沒資料,
似乎是你的程式在清空後本就沒有給 H3 值.

作者: myleoyes 時間: 2010-12-21 10:38

回復 3# luhpro
luhpro前輩你好!
GBKEE 前輩你好!
　　　　兩位前輩!謝謝!現在問題不在於H3需不需要值,
      而是當按A9鈕修改數據後,卻發現影響到填滿
      所以需要用手動的方式執行填滿
      但因資料多又忙碌常常忘記原始資料當初
      是在哪一列開始填滿,間隔又是多少列
      所以列印出來才發現與原稿有誤
      免不了主管的%$#@....哈哈!!
      所以才想是否修改程式可以解決這個煩瑣的問題
      想囉!兩天這種想法應該是不行
      卻想到解決之道,請先教小第"參照填滿"這個程式
      如附檔Leov37-2說明,那就可以迎刃而解
      雖非良策,卻可避免錯誤又快速喔!
      請不吝賜教謝謝再三!!

作者: luhpro 時間: 2010-12-22 22:19

本帖最後由 luhpro 於 2010-12-22 22:22 編輯

你的檔案裡說 :
AB6作為填滿的開始列,就是(A5)的位置
AB7作為填滿的間隔列數
從A3開始往下填滿,請問程式為何?

上面的敘述在邏輯上有些怪怪的,
以 A5 作為填滿的開始列,
填滿的間隔列數是 10
再看你特地將 A5、A15、A25 框起來,
我猜你的意思是說填滿的對象是你框起來的那些儲存格A5、A15、A25、....

但你底下又補充說要以 A3 為填滿開始的儲存格,
3 + 10 = 13
怎麼樣也不會對應到 A15 呢.

那麼到底你是要對 A3、A13、A23、... 還是 A5、A15、A25、... 做填滿呢?

另外若是你想用 AutoFill 函數的話, 該函數的說明裡有提到 :

Destination    必選的 Range 物件類型。要填滿的儲存格。目標範圍必須包括來源範圍。

而在 Range 裡又有定義 :

代表某一儲存格、某一欄、某一列、某一指定範圍 (該指定範圍可包含一個或若干連續儲存格範圍) 或者某一立體範圍。

所以 AutoFill 的填滿動作是不能跳行或是跳列填滿的. (故而你上面說的 "填滿的間隔列數是 10" 的情形並不適用)

比較恰當可行的方式是用
For ... Step 10
.
.
.
Next

或是用

While iI < xxx
  .
  .
  .
  iI = iI + 10
Wend

的方式來實做.

至於想用程式來達到取得上述參照值的儲存格內容方式倒是不困難

想透過 AB6 找到 A5 可用如下方法 :

Sub AFill()
  Dim iSRow%, iRow%, iTarget%

  With Sheets("Sheet1")
iSRow = .[AB6]
iRow = .Range(.[A3], .Cells(.[A3].End(xlDown), 1)).Find(iSRow, LookIn:=xlValues).Row
iTarget = .Cells(iRow, 1) '這個就是 A5 的位置, 只要變更後面的 1 對應到想 Fill 的欄位數即可,例如 : M5 就是 .Cells(iRow, 13)
  End With
End Sub

取得 iRow 後,
只要於迴圈內依次增加此值即可 "跳列" 對應到需要填滿的儲存格.

作者: myleoyes 時間: 2010-12-23 12:21

回復 5# luhpro
luhpro前輩你好!
      前輩!謝謝!需求如附檔案
      請先開啟Leov37-41執行看看
      再開啟Leov37-4就知道需求
      請不吝賜教謝謝再三!!

作者: luhpro 時間: 2010-12-24 00:03

回復 6# myleoyes
物件不支援此屬性或方法. O.O"

我的 Office 2003 不讓我執行,
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
這三個屬性它都不認識.

為避免失之毫釐 ; 差之千里的情形出現,
我暫時只能先潛水了,
沒能幫到忙, 很抱歉...

作者: myleoyes 時間: 2010-12-25 09:41

回復 7# luhpro
luhpro前輩你好!
      前輩!非常感激謝謝!再附檔案
      Leov37-5,Leov37-51在2003應可以執行,將原填滿程式
      Sub 填滿()
         Dim E&, i&
         Range("AB6") = ActiveCell '加入這一行開始列的參照位置
         E = Cells(ActiveCell.Row, 1).End(xlDown).Row
      Again:
         ZZ = Application.InputBox("請輸入列數", "請輸入填滿間隔列數", 10, Type:=2)
         If ZZ = "" Or ZZ = False Then End
         Range("AB7") = ZZ '加入這一行間隔列數的參照數據
         If ZZ <= 0 Then
         MsgBox "列數間隔不得小於１列！！！", , "列數錯誤請重新輸入！！"
         GoTo Again
         End If
         For i = ActiveCell.Row To E Step ZZ
         With Cells(i, 1).Resize(, 15).Interior
         .ColorIndex = 34
      End With
         Next
         Range("AB5") = 1 '加入這一行A欄的參照開關
      End Sub
      所以當資料改完後執行參照填滿
      因為小弟能力不足,所以用拼湊的方式
      先找到位置再執行填滿,就能解決困擾的問題
      Sub IA()
         清除填滿
               HA
         MA
         參照填滿
         Range("I3").Select
         Range("I:I").EntireColumn.AutoFit
      End Sub
      Sub 參照填滿()
         Dim E&, i&
         找到位置
         E = Cells(ActiveCell.Row, 1).End(xlDown).Row
         For i = ActiveCell.Row To E Step Range("AB7")
         With Cells(i, 1).Resize(, 15).Interior
               .ColorIndex = 34
         End With
         Next
         Range("AB5:AB7") = ""
      End Sub
      Sub 找到位置()
         With Sheet1
         Set c = Range("AB6")
         Set Rng = .Cells.Find(Format(c, "0列"), LookIn:=xlValues, LookAt:=xlWhole)
               .Select
         If Not Rng Is Nothing Then Rng.Select
      End With
      End Sub
      只是原本應該不需要如此複雜
      無奈!!能力只有如此這般..!!
      前輩能否簡化程式嗎?
      希望有能力的前輩,請不吝賜教謝謝再三!!
      小弟在此順祝各位前輩!
            聖誕節快樂!!身體健康事事如意...

作者: GBKEE 時間: 2010-12-25 11:46

回復 8# myleoyes
是這樣嗎?

Sub 填滿()
Dim E&, i&, R As Range, T%,ZZ
Range("AB6") = ActiveCell
E = Cells(ActiveCell.Row, 1).End(xlDown).Row
Again:
ZZ = Application.InputBox("請輸入列數", "請輸入填滿間隔列數", 10, Type:=2)
If ZZ = "" Or ZZ = False Then End
Range("AB7") = ZZ
If ZZ <= 0 Then
MsgBox "列數間隔不得小於１列！！！", , "列數錯誤請重新輸入！！"
GoTo Again
End If
Range("AB5") = 1
Application.EnableEvents = False
For i = ActiveCell.Row To E
For Each R In Range("c:e,g:i,m:m").Columns
T = IIf(i + ZZ <= E, ZZ + 1, E - i + 1)
If Mid(R.Cells(i).Formula, 1, 1) = "=" Then
R.Cells(i).AutoFill R.Cells(i).Resize(T)
Else
R.Cells(i).Offset(-1).Resize(2).AutoFill R.Cells(i).Offset(-1).Resize(T + 1)
End If
Next
Cells(i, 1).Resize(, 15).Interior.ColorIndex = 34
i = i + ZZ - 1
Next
Application.EnableEvents = True
End Sub

複製代碼

作者: myleoyes 時間: 2010-12-26 15:53

回復 9# GBKEE
GBKEE良師你好!
　　　良師!謝謝!程式的想法有誤
         小弟如此比喻填滿分為手動(填滿)
         與自動(填滿)兩部份解釋
         當執行手動(填滿)時,加入Range("AB6") = ActiveCell
         這一行作為自動(填滿)開始列的參照位置
         加入Range("AB7") = ZZ
         這一行作為自動(填滿)間隔列數的參照數據
         加入Range("AB5") = 1
         這一行作為關閉手動(填滿)A欄的開關
         因為A欄是觸發點,所以要執行自動(填滿)必須關閉手動(填滿)
         因此只要手動(填滿)作任何動作,都會留下軌跡
         供自動(填滿)作依據,確保動作一致無誤
         所以要執行自動(填滿)就必須先找到A欄的位置
         如今良師將手動(填滿)與自動(填滿)兩部份
         合併為單一程式,所以執行手動(填滿)是OK!!
         但當按鈕9A時就凸槌囉!!因為你的程式
         Dim E&, i&, R As Range, T%, ZZ
         Range("AB6") = ActiveCell這一列依然存在
         所以AB6會將原來的數字變成按鈕9A
         因而失去功能如附檔請參考看看
         辛苦囉!謝謝再三!!

作者: GBKEE 時間: 2010-12-26 16:48

本帖最後由 GBKEE 於 2010-12-26 16:49 編輯

回復 10# myleoyes
自動填滿: ActiveCell 在A欄 ,是 "C:E,G:I,M:M" 等欄的填滿 .
手動填滿: 按鈕8A ,按鈕9A,按鈕10A 是各欄單獨的的填滿.
都依據 AB5:AB7 的數據來填滿的
這樣的說法對嗎?
請問數字填滿的等差數,都是依據 AB5的數字嗎?
標題3 差2位, 標題5 差1位,標題7 連續沒有一致規則性?

標題3	標題4	標題5	標題7
2	0.065	10
4	0.065	11	5
6	0.065	12	5

作者: myleoyes 時間: 2010-12-26 18:22

回復 10# myleoyes
GBKEE良師你好!
　　　良師!謝謝!不好意思..你可能有些誤解
         再附檔這是經過實際測試OK!的檔
         良師!其實你只要將找到位置與參照填滿
         合併就可以囉!因為找到位置的方式
         必須要在A欄作自訂格式,否則程式
         永遠只會找到AB6的位置不會找不到
         A欄的位置,辛苦囉!謝謝再三!!

作者: GBKEE 時間: 2010-12-26 20:48

回復 12# myleoyes
是這樣嗎?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target(1), Range("A5:A152")) Is Nothing Then
If Target(1) <> "" And Range("AB5") = "" And Range("AB8") = "" Then 填滿
End If
If Not Intersect(Target(1), Range("H1:I2,M1:M2")) Is Nothing Then
If Range("AB5") = 1 Or Range("AB8") = 2 Then 清填滿
Range("AB5") = ""
Select Case Target(1).Address(0, 0)
Case "H1"
HA
Case "H2"
HB
Case "I1"
IA
Case "I2"
IB
Case "M1"
MA
Case "M2"
MB
End Select
End If
End Sub

複製代碼

作者: myleoyes 時間: 2010-12-27 21:18

回復 13# GBKEE
GBKEE良師你好!
　　　良師!謝謝!辛苦囉!謝謝再三!!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target(1), Range("A5:A152")) Is Nothing Then
      If Target(1) <> "" And Range("AB5") = "" And Range("AB8") = "" Then 填滿
End If
If Not Intersect(Target(1), Range("H1:I2,M1:M2")) Is Nothing Then
End If
      Select Case Target(1).Address(0, 0)
      Case "C1"
         If Range("AB5") = 1 Or Range("AB8") = 2 Then 清填滿
         Range("AB5") = ""
      Case "H1"
         HA
      Case "H2"
         HB
      Case "I1"
         IA
      Case "I2"
         IB
      Case "M1"
         MA
      Case "M2"
         MB
End Select
End Sub

作者: GBKEE 時間: 2010-12-28 14:21

回復 14# myleoyes
還欠缺什麼?? 清填滿嗎?
自己可以試試加上清填滿的條件.

作者: myleoyes 時間: 2010-12-28 20:40

回復 15# GBKEE
GBKEE良師你好!
　　　良師!謝謝!已經可以應付主管的要求囉!
不好意思再浪費你寶貴的時間謝謝再三!!

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)