請高手指點一下，如何做出動態的行事曆及雙擊選擇輸入的功能？

eigen

請高手指點一下，如何做出動態的年曆及雙擊選擇輸入的功能？

如附件

https://dl.dropboxusercontent.com/u/12575824/%E8%A1%8C%E4%BA%8B%E6%9B%86.xls

我需要一個日期輸入的功能，目前外觀大致上就像附件這樣。

我要在輸入頁 ， 選擇一個 儲存格（基本上是 日期欄 下面），按下快速鍵後，會跳到年曆這一頁。（這部份應該ok）

年曆這一樣，我希望第一行第一個，是上個月，第二以才是 today()所在的月份。以此顯示12個月份。

一、因今天的月份會變，所以整個會變成是動態調整。請指教，這樣的功能該如何下手？

二、雙擊儲存格，會將該日期寫到輸入頁，選擇的儲存格之中。如果無法雙擊，改用快速鍵輸入也是可以。
目前不知道該如何做到這樣的功能，請指令一下。

三、目前年曆的 2013-12 2014-1~2014-10 這幾個是用 today() - 30 -60 -90-120 -150 ... 這樣的『爛』方法做出來的
請指教，該怎麼做比較好~~

eigen

如附件
https://dl.dropboxusercontent.com/u/12575824/%E8%A1%8C%E4%BA%8B%E6%9B%86.xls

每個月的第一天，我用 =eomonth(TODAY(),quotient(COLUMN()-2,8)+quotient(ROW()-2,9)*4-5)+1 解決了

每個月的每一天，我用
                OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)
-(weekday(        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,),1)-1)
+ MOD(ROW()-4,9)*7
+MOD(COLUMN()-2,8)

解決了
為了要好看，又加上了
=if(        month(OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,))<>
        month(OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)-(weekday(        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,),1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8)),
        "",
        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)-(weekday(        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,),1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8))



※現在的問題
不難發現，指令太長了，又臭又長
OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)-(weekday(        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,),1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8)
太長了，我原本想要用 插入->名稱->定義 的方式解決，但是定義 month_first_day -->OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)

再將每日的計算公式寫成
=if(        month(        month_first_day)<>
        month(        month_first_day-(weekday(        month_first_day,1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8)),
        "",
                month_first_day-(weekday(        month_first_day,1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8))

無法使用，請指教、指點，謝謝

GBKEE

回復 2# eigen
試試看

1. Option Explicit
   
2. '工作表模組:雙擊儲存格程式
   
3. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
4.     Ex Target.Cells(1), Target.Parent
   
5.     Target.Select
   
6. End Sub
   
7. 
   
8. Private Sub Ex(Rng As Range, sh As Worksheet)
   
9.     Dim T_Date, T_Mon As Integer, TE As Date
   
10.     Dim M As Integer, Week_Ar(), I As Integer
    
11.     Week_Ar = Array("日", "一", "二", "三", "四", "五", "六")
    
12.     Do Until IsDate(T_Date)
    
13.         T_Date = InputBox("請指定日期", , Date)
    
14.         If T_Date = "" Then Exit Sub
    
15.     Loop
    
16.     With sh
    
17.         .Cells.Clear                            '清除工作表
    
18.         .Cells.HorizontalAlignment = xlCenter   '儲存格物件的水平對齊模式:置中
    
19.         .Cells.VerticalAlignment = xlCenter     '儲存格物件的垂直對齊模式:置中
    
20.     End With
    
21.    
    
22.     With Rng.Resize(, 7)                        '指定日期的格式
    
23.         .Merge                                  '合併: .Resize(, 7)
    
24.         .Font.Size = 30
    
25.         .Font.Bold = True
    
26.         .Font.Color = vbBlue
    
27.         .NumberFormatLocal = "yyyy-m-d"
    
28.          Rng = T_Date                           '日期
    
29.     End With
    
30.     I = I + 3
    
31.     For M = -1 To 1
    
32.         T_Date = DateAdd("M", M, Rng.Cells(1))                           '取得指定月份的日期
    
33.         T_Date = DateSerial(Year(T_Date), Month(T_Date), 1)     '指定月份日期的 1號開始
    
34.         T_Mon = Month(T_Date)                                   '指定的月份
    
35.         With Rng.Cells(I).Resize(1, 7)                          '寫入 指定月份的格式
    
36.             .Merge
    
37.             .Cells = T_Date
    
38.             .NumberFormatLocal = "yyyy-m"
    
39.             .Font.Size = 15
    
40.             .Font.Bold = True
    
41.             .Font.Color = vbWhite
    
42.             .Interior.Color = vbBlue
    
43.         End With
    
44.         I = I + 1
    
45.         With Rng.Cells(I).Resize(, 7)                           '寫入星期的格式
    
46.             .Cells = Week_Ar
    
47.             .Interior.ColorIndex = 15
    
48.             .Range("A1,G1").Font.Color = vbRed
    
49.         End With
    
50.         I = I + 1
    
51.         Do While T_Mon = Month(T_Date)                          '迴圈的條件:同一個月份
    
52.             With Rng.Cells(I, Weekday(T_Date))
    
53.                 .Cells = T_Date
    
54.                 .NumberFormatLocal = "D"
    
55.                 If Weekday(T_Date) = 1 Or Weekday(T_Date) = 7 Then .Font.Color = vbRed
    
56.             End With
    
57.             If Weekday(T_Date) = 7 And T_Mon = Month(T_Date + 1) Then I = I + 1
    
58.             T_Date = T_Date + 1                                 '日期加一天
    
59.         Loop
    
60.         I = I + 2
    
61.     Next
    
62. End Sub

複製代碼

eigen

回復 3# GBKEE


謝謝大大的大力幫忙，我試著修改，目前已經『大致』ok了，

我參考你的範例，修改程式

如附件
https://dl.dropboxusercontent.com/u/12575824/%E8%A1%8C%E4%BA%8B%E6%9B%86.xls

1. Option Explicit
   
2. '工作表模組:雙擊儲存格程式
   
3. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
4. Dim aa As Integer
   
5. 
   
6.         Cells(7, 2).Value = Target.Cells(1, 1)                'copy to B2
   
7.         'Cells(7, 2).NumberFormatLocal = "G/通用格式"
   
8. 
   
9.         Ex Cells(7, 2), Target.Parent
   
10. 'Target.Select
    
11. End Sub
    
12. 
    
13. Private Sub Ex(Rng As Range, sh As Worksheet)
    
14.         Dim E As Range
    
15. 
    
16.         If Rng = "" Then Exit Sub
    
17.         If IsNumeric(Rng) Then
    
18.                 Sheets("Sheet1").Activate
    
19.                 If Selection.Row > 1 And Selection.Row < 52 And Selection.Column >= 6 And Selection.Column <= 7 Then
    
20.                         Selection.Value = Rng
    
21.                 End If
    
22.         End If
    
23. End Sub

複製代碼

加到 sheet 月曆之中，並在 sheet1 之中加入

1. Option Explicit
   
2. '工作表模組:雙擊儲存格程式
   
3. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
4.         If Target.Cells(1).Row > 1 And Target.Cells(1).Row < 52 And Target.Cells(1).Column >= 6 And Target.Cells(1).Column <= 7 Then
   
5.                 Sheets("月曆").Activate
   
6.         End If
   
7. End Sub

複製代碼

如此一來，我便可以在兩個sheet 中，用 雙擊做切換。（這部份功能ok了，十二萬分的感謝）

現在我不了解的是

一、原本提供的程式是

Ex Target.Cells(1), Target.Parent

這個 Target.Cells(1) 我怎麼改，都改不出原始值（都是經過格式化的資料），最後我沒折，只好將值寫到b2 ，再將b2 的值丟出來（看不到值是因為字型顏色我調整白色）

二、
計算日期
=if(        month(OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,))<>
        month(OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)-(weekday(        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,),1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8)),
        "",
        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)-(weekday(        OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,),1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8))
這個熱熱長的程式，有機會縮短嗎？ （例如用 名稱 定義）

eigen

追求完全的最後一關，將右側表列的休假日，在左側的月曆中，將字型改用紅色

如附件
https://dl.dropboxusercontent.com/u/12575824/%E8%A1%8C%E4%BA%8B%E6%9B%86.xls

因為日期都是用算的，位置不固定，我不知如何下手

就算用 『設定格式化的條件』也只能有三個條件，無法將數十個日期加上去，請高手指點~~謝謝

GBKEE

回復 4# eigen

1. '工作表模組:雙擊儲存格程式
   
2. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
3.     Ex Target, Target.Parent
   
4.     'Sub Ex 的程式碼中
   
5.     'With Rng.Resize(, 7)    '日期的範圍
   
6.     '   .Merge               '合併為儲存格
   
7.     '*** -> Target.Resize(, 7)  合併為儲存格  ****
   
8.     '***    原本的位置當你再次,雙擊儲存格,看看有何變化
   
9. End Sub

複製代碼

這工作表函數落落長,眼力不好,有請眼力好者,幫幫忙.

eigen

回復 6# GBKEE


   呵~~我的眼力也很差，寫的時候，我是用 ultraedit 一段一段拼出來後，才貼到 excel

目前我用眼不見為淨的方式，儲存格格式->保護->隱藏 加上工具->保護 將公式隱藏起來（不然一點儲存格，整個畫面#$$^%）

eigen

回復 6# GBKEE

我試過 Ex Target, Target.Parent

下載 (18.07 KB)

2013-12-16 21:22

雙擊時target 變成 1/23/2014 經過格式化的值而不是 41662 ，以致於後面我的檢查程序都無法運作。

日曆上的日期都是正確的日期，只是透過儲存格格式 自定成 DD 或 YYYY-MM ，原始資料都還是 數值

利用這樣的特性，我在雙擊儲存格時，我就知道使用者點擊的是不是日期。

stillfish00

回復 7# eigen
我用2樓定義名稱沒問題啊!
month_first_day
=OFFSET($B$2,QUOTIENT(ROW()-4,9)*9,QUOTIENT(COLUMN()-2,8)*8,,)

calc_day
=IF(MONTH(month_first_day)<>MONTH(month_first_day-(WEEKDAY(month_first_day,1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8)),"",month_first_day-(WEEKDAY(month_first_day,1)-1)+ MOD(ROW()-4,9)*7 +MOD(COLUMN()-2,8))

eigen

回復 9# stillfish00


Dear Sir,
麻煩再幫一下

如附件
https://dl.dropboxusercontent.com/u/12575824/%E8%A1%8C%E4%BA%8B%E6%9B%86.xls

quotient 到底是那出了問題？

下載 (89 KB)

2013-12-16 23:19