夢想工作表

myleoyes

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

myleoyes

回復 1# myleoyes
各位前輩你們好!
　　      前輩!上次附檔案的下畫面筆誤
          再附檔案以免誤導前輩指導方向
          請知道的前輩,不吝賜教謝謝再三!!

GBKEE

回復 2# myleoyes

1. Sub 年度項目()
   
2.    Dim Y, C%, TILE$, Sh As Worksheet
   
3.    Sheets("首頁").Activate
   
4.    On Error GoTo Er:
   
5. Ag:
   
6.     Y = InputBox("輸入年度" & TILE, , 99)
   
7.     If Y = "" Then Exit Sub
   
8.     Set Sh = Sheets(Y & "年度夢想")
   
9.     With Range("A4:E4")
   
10.         .Insert 'Shift:=xlDown
    
11.         .Cells(0, 1).NumberFormatLocal = "YYYY/MM/DD"
    
12.         .Cells(0, 1) = Y & "/1/1"
    
13.         .Cells(0, 2) = Sh.Name
    
14.         For I = 1 To Sh.Range("A:A").SpecialCells(xlCellTypeFormulas).Cells.Count
    
15.             .Cells(0, I + 2) = Sh.Range("A:A").SpecialCells(xlCellTypeFormulas).Areas(I)
    
16.         Next
    
17.    End With
    
18.    Exit Sub
    
19. Er:
    
20.    TILE = Chr(10) & "  *** 找不到 " & Y & "年度夢想 工作表 ***"
    
21.    Resume Ag
    
22. End Sub

複製代碼

myleoyes

回復 3# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!程式無法接受儲存格有公式
         再附檔參考看看請再辛苦囉!!謝謝再三!!

GBKEE

復 4# myleoyes
   Leov18-2.xls 中只有夢想  Leov18-1.xls 中有夢想,99,100裡面都是公式  
給你的程式中 .SpecialCells(xlCellTypeFormulas) 就是公式的參數
應該是 如圖的需求 你沒有說清楚

下載 (11.5 KB)

2010-8-3 17:31

1. Sub 年度項目()
   
2. Dim Y, C%, TILE$, Sh As Worksheet
   
3. Sheets("首頁").Activate
   
4. On Error GoTo Er:
   
5. Ag:
   
6. Y = Application.InputBox("輸入年度" & TILE, , 99)
   
7. If Y = False Then Exit Sub
   
8. If Y = "夢想" Then
   
9. Set Sh = Sheets("夢想")
   
10. Else
    
11. Set Sh = Sheets(Y & "年度夢想")
    
12. End If
    
13. With Range("A4:E4")
    
14. .Insert 'Shift:=xlDown
    
15. .Cells(0, 1).NumberFormatLocal = "YYYY/MM/DD"
    
16. .Cells(0, 1) = Y & "/1/1"
    
17. .Cells(0, 2) = Sh.Name
    
18. For I = 1 To Sh.Range("A:A").SpecialCells(xlCellTypeFormulas).Cells.Count
    
19. .Cells(0, I + 2) = Sh.Range("A:A").SpecialCells(xlCellTypeFormulas).Areas(I)
    
20. Next
    
21. End With
    
22. Exit Sub
    
23. Er:
    
24. TILE = Chr(10) & " *** 找不到 " & Y & "年度夢想 工作表 ***"
    
25. Resume Ag
    
26. End Sub

複製代碼

myleoyes

回復 5# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!歹勢!!
         你誤解問題所在...
         問題在於夢想工作表A欄的儲存格
         如果 A2="夢想"如再附檔Leov18-4
         不是公式所以程式執行後正確
         如果 A2=IF(AL4=3,"成真","夢想")
         如再附檔Leov18-3
         是公式所以程式執行後F與G多出資料
         而且C欄也錯,
         這就是凸槌所在,麻煩請再辛苦!!
         謝謝再三!!

GBKEE

回復 6# myleoyes
修改範圍
I = 1
For Each A In Sh.Range("A3:A" & Rows.Count).SpecialCells(xlCellTypeFormulas).Cells
        .Cells(0, I + 2) = A
        I = I + 1
Next

myleoyes

回復 7# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!這樣就對辛苦囉!!
         另有一問題麻煩請再指導
         謝謝再三!!

GBKEE

回復 8# myleoyes
Formula->公式  Ex:   Range("a5").Formula="=a1+a8"
R = InputBox("請更改公式", , ActiveCell.Formula)

myleoyes

回復 9# GBKEE
GBKEE前輩你好!
　　　　 良師!謝謝!辛苦囉!!
         謝謝再三!!