避免重複執行程式

myleoyes

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

GBKEE

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

luhpro

回復 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

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

luhpro

你的檔案裡說 :
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

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

luhpro

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

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

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

myleoyes

回復 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

回復 8# myleoyes
是這樣嗎?

1. Sub 填滿()
   
2.      Dim E&, i&, R As Range, T%,ZZ
   
3.      Range("AB6") = ActiveCell
   
4.      E = Cells(ActiveCell.Row, 1).End(xlDown).Row
   
5. Again:
   
6.       ZZ = Application.InputBox("請輸入列數", "請輸入填滿間隔列數", 10, Type:=2)
   
7.       If ZZ = "" Or ZZ = False Then End
   
8.       Range("AB7") = ZZ
   
9.       If ZZ <= 0 Then
   
10.         MsgBox "列數間隔不得小於１列！！！", , "列數錯誤請重新輸入 ！！"
    
11.         GoTo Again
    
12.       End If
    
13.       Range("AB5") = 1
    
14.     Application.EnableEvents = False
    
15.     For i = ActiveCell.Row To E
    
16.         For Each R In Range("c:e,g:i,m:m").Columns
    
17.             T = IIf(i + ZZ <= E, ZZ + 1, E - i + 1)
    
18.             If Mid(R.Cells(i).Formula, 1, 1) = "=" Then
    
19.                 R.Cells(i).AutoFill R.Cells(i).Resize(T)
    
20.             Else
    
21.                 R.Cells(i).Offset(-1).Resize(2).AutoFill R.Cells(i).Offset(-1).Resize(T + 1)
    
22.             End If
    
23.         Next
    
24.         Cells(i, 1).Resize(, 15).Interior.ColorIndex = 34
    
25.         i = i + ZZ - 1
    
26.     Next
    
27.     Application.EnableEvents = True
    
28. End Sub

複製代碼

myleoyes

回復 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
           因而失去功能如附檔請參考看看
           辛苦囉!謝謝再三!!