避免重複執行程式

帖子: 463
主題: 116
精華: 0
積分: 580
點名: 0
作業系統: Vista
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2010-5-4
最後登錄: 2017-11-13

論壇贊助勳章論壇榮譽勳章

2^#

發表於 2010-12-21 10:38 | 顯示全部帖子

[版主管理留言]

Hsieh(2010-12-21 12:15): 請清楚敘述您的需求邏輯

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

Leov37-2.rar (43.57 KB)

帖子: 463
主題: 116
精華: 0
積分: 580
點名: 0
作業系統: Vista
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2010-5-4
最後登錄: 2017-11-13

論壇贊助勳章論壇榮譽勳章

3^#

發表於 2010-12-23 12:21 | 顯示全部帖子

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

Leov37-41.rar (16.89 KB)

Leov37-4.rar (15.82 KB)

帖子: 463
主題: 116
精華: 0
積分: 580
點名: 0
作業系統: Vista
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2010-5-4
最後登錄: 2017-11-13

論壇贊助勳章論壇榮譽勳章

4^#

發表於 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
      只是原本應該不需要如此複雜
      無奈!!能力只有如此這般..!!
      前輩能否簡化程式嗎?
      希望有能力的前輩,請不吝賜教謝謝再三!!
      小弟在此順祝各位前輩!
            聖誕節快樂!!身體健康事事如意...

Leov37-5.rar (13.77 KB)

Leov37-51.rar (13.24 KB)

帖子: 463
主題: 116
精華: 0
積分: 580
點名: 0
作業系統: Vista
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2010-5-4
最後登錄: 2017-11-13

論壇贊助勳章論壇榮譽勳章

5^#

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

Leov37-6.rar (18.63 KB)

帖子: 463
主題: 116
精華: 0
積分: 580
點名: 0
作業系統: Vista
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2010-5-4
最後登錄: 2017-11-13

論壇贊助勳章論壇榮譽勳章

6^#

發表於 2010-12-26 18:22 | 顯示全部帖子

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

Leov37-7.rar (19.59 KB)

帖子: 463
主題: 116
精華: 0
積分: 580
點名: 0
作業系統: Vista
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2010-5-4
最後登錄: 2017-11-13

論壇贊助勳章論壇榮譽勳章

7^#

發表於 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

帖子: 463
主題: 116
精華: 0
積分: 580
點名: 0
作業系統: Vista
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2010-5-4
最後登錄: 2017-11-13

論壇贊助勳章論壇榮譽勳章

8^#

發表於 2010-12-28 20:40 | 顯示全部帖子

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