減化程式

myleoyes

各位前輩你們好!
　　      各位前輩!這程式如何減化它?
           Private Sub Worksheet_SelectionChange(ByVal Target As Range)
              Select Case Target(1).Address(0, 0)
                Case "A3"
                 If Target(1) <> "" And [A3] = "連結本年度" Then 夢想
                Case "F3"
                 If Target(1) <> "" And [F3] = "連結本年度" Then 成真
                Case "A4"
                 If Target(1) <> "" And [A4] = "連結99年度" Then 夢想99
                Case "F4"
                 If Target(1) <> "" And [F4] = "連結99年度" Then 成真99
                Case "A5"
                 If Target(1) <> "" And [A5] = "連結100年度" Then 夢想100
                Case "F5"
                 If Target(1) <> "" And [F5] = "連結100年度" Then 成真100
                 至
                Case "A50"
                 If Target(1) <> "" And [A50] = "連結145年度" Then 夢想145
                Case "F50"
                 If Target(1) <> "" And [F50] = "連結145年度" Then 成真145
            請知道的前輩,不吝賜教謝謝再三!!

GBKEE

回復 1# myleoyes

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.    'Sheet1 是程序  夢想 or  成真 所在的模組 請自行修改 ; 'Target(1).Column = 1 A欄   ;     'Target(1).Column = 6 F欄
   
3.     Dim Msg%
   
4.     If (Target(1).Column = 1 Or Target(1).Column = 6) And Target(1) Like "連結*年度" Then
   
5.         Msg = Val(Replace(Replace(Target(1), "連結", ""), "年度", ""))
   
6.         If Msg > 0 Then
   
7.             If Target(1).Column = 1 Then Run "Sheet1.夢想" & Msg Else Run "Sheet1.成真" & Msg
   
8.          Else
   
9.             If Target(1).Column = 1 Then 夢想 Else 成真
   
10.         End If
    
11.     End If
    
12. End Sub

複製代碼

myleoyes

回復 2# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!歹勢不行耶請麻煩看看
         附檔案Leov24,附檔案Leov24-1是
         本來的作法謝謝再三!!

GBKEE

回復 3# myleoyes
Sheet1 是程序  夢想 or  成真 所在的模組 請自行修改
這個意思是 Run "Sheet1.夢想" & Msg   的 Sheet1 是工作表物件模組中的程序   "夢想" & Msg 所在
如 程序 "夢想" & Msg  改放別的物件模組就 請你要自行修改   
如今你的附檔分別 放在一般模組  (成真模組 , 夢想模組)  且程序是 公用程序  就不加上模組的名稱了

1. If Msg > 0 Then
   
2. If Target(1).Column = 1 Then Run "夢想" & Msg Else Run "成真" & Msg
   
3. Else
   
4. If Target(1).Column = 1 Then 夢想 Else 成真
   
5. End If

複製代碼

myleoyes

回復 4# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!歹勢!!對於毫無基礎的小弟
         實在真是辛苦你....真是甘溫
         另一問題如附檔案的成真模組與夢想模組
         Sub 成真()
             Sheet6.Select
             Range("A1").Select
          End Sub
         Sub 成真99()
            Sheet8.Select
            Range("A1").Select
          End Sub
         Sub 夢想()
            Sheet7.Select
            Range("A1").Select
          End Sub
         Sub 夢想99()
            Sheet9.Select
            Range("A1").Select
         End Sub
         等等這樣煩多的程式可否如前程式一樣的減化它
         請不另再賜教謝謝再三!!

GBKEE

回復 5# myleoyes
試試看


re-Leov24.rar (18.68 KB)

下載次數: 9

2010-8-12 07:35

myleoyes

回復 6# GBKEE
GBKEE前輩你好!
　　　良師!謝謝!哇!帥呆囉!!哈哈!!
           讚阿!!良師真是厲害!!
           小弟一定要好好研究..
           不過歹勢!!再請教
        Sub 隱藏表()
            Sheets(Array("102年度夢想", "102年度成真", "101年度夢想", "101年度成真", "100年度夢      
                想", "100年度成真", _"99年度夢想", "99年度成真")).Select
            Sheets("99年度成真").Activate
            ActiveWindow.SelectedSheets.Visible = False
            Sheets("首頁").Select
            Range("A1").Select
        End Sub
        Sub 展開表()
            Sheets("102年度夢想").Visible = True
            Sheets("102年度成真").Visible = True
            Sheets("101年度夢想").Visible = True
            Sheets("101年度成真").Visible = True
            Sheets("100年度夢想").Visible = True
            Sheets("100年度成真").Visible = True
            Sheets("99年度夢想").Visible = True
            Sheets("99年度成真").Visible = True
            Sheets("首頁").Select
            Range("A1").Select
        End Sub
            這兩個程式如何減化它
            尤其是隱藏表程式是否能以B4做為參照基礎
            當按隱藏表鈕時,程式得知現在B4=103年度夢想
            程式就從103年度夢想之後開始隱藏工作表
            再辛苦你囉....!!謝謝再三!!

GBKEE

回復 7# myleoyes

1. Sub 隱藏表()
   
2.     Dim E As Range
   
3.     If Range("B4").End(xlDown).Row = Rows.Count Then Exit Sub
   
4.     For Each E In Range("B5:B" & Range("B4").End(xlDown).Row)
   
5.         Sheets(E.Value).Visible = False
   
6.     Next
   
7.     Range("A1").Select
   
8. End Sub
   
9. Sub 展開表()
   
10.     Dim Sh As Worksheet
    
11.     For Each Sh In Sheets
    
12.     Sh.Visible = True
    
13.     Next
    
14.     Range("A1").Select
    
15. End Sub

複製代碼

myleoyes

回復 8# GBKEE
GBKEE前輩你好!
　　　良師!謝謝!為了弄懂
       Sheet1是程序  夢想 or  成真 所在的模組
        小第重做檔案卻發現無法回首頁
         多次修改還是找不到問題所在
          歹勢!!只好再辛苦良師!
           真的好抱歉...!!謝謝再三!!

GBKEE

回復 9# myleoyes
Sorry  *  點錯邊  If Sh.Name Like "成真*" Or Sh.Name Like "夢想*" Then   
                 改成  If Sh.Name Like "*成真" Or Sh.Name Like "*夢想" Then