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

複製代碼

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

複製代碼

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

GBKEE

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