Hsieh

無法得知年分

Hsieh

回復 3# 周大偉

nn.rar (5.86 KB)

下載次數: 34

2011-6-16 23:48

Hsieh

回復 6# 317


以4#檔案為例
原來第2列是由使用者自行輸入
改用公式
G2=IF(MONTH(DATE($AL$1,y,COLUMN(A1)))<>--y,"",DAY(DATE($AL$1,y,COLUMN(A1))))
G3=IF(G2="","",CHOOSE(WEEKDAY(--($AL$1&"/"&SUBSTITUTE(MID(x,FIND("]",x)+1,3),"月","")&"/1")+G2-1,2),"一","二","三","四","五","六","日"))
向右複製
因為工作表名稱是月份，所以使用公共定義取出工作表名稱的數字部分當作月份，這樣更改工作表名稱與年份的數值就能正確顯示日期
日曆.rar (11.49 KB)

下載次數: 22

2011-6-19 09:46

Hsieh

回復 7# 周大偉
看不懂你要如何整理多年資料
看看8#檔案是否你能應用，再把你的需求講清楚

Hsieh

回復 11# 317


    公式中的x是使用cell函數得到的filename
你在其它空白處寫入公式=x就知道x內容是什麼
看中括號內代表的是參照中的什麼位置就知道find的作用了

Hsieh

回復 14# 周大偉


    巨集公式?
我的方法沒有用到巨集阿
應該是定義名稱的問題
你要把定義名稱在新活頁簿中建立
並且該檔案已經儲存
至於該訊息我就沒遇過不知是為何產生的

Hsieh

回復 17# 317

1. Sub Ex()
   
2. Dim Ar()
   
3.    y = [AL1]
   
4.    m = Val(ActiveSheet.Name)
   
5.    If m < 1 Or m > 12 Then MsgBox "工作表名稱需要符合1~12月": Exit Sub
   
6.    d = 1
   
7.    mydate = DateSerial(y, m, d)
   
8.    Do Until Month(mydate) <> m
   
9.      ReDim Preserve Ar(s)
   
10.      k = Format(mydate, "aaa")
    
11.      Ar(s) = Array(d, Format(mydate, "aaa"))
    
12.      s = s + 1
    
13.      d = d + 1
    
14.      mydate = DateSerial(y, m, d)
    
15.    Loop
    
16.    [G2:AK3] = ""
    
17.    [G2].Resize(2, s) = Application.Transpose(Ar)
    
18. End Sub

複製代碼

Hsieh

回復 19# 317


         Ar(s) = Array(d, Replace(Format(mydate, "aaa"), "週", ""))

Hsieh

回復 22# 317

可能是版本問題
Format的格式用"aaa"在我的電腦上是顯示"週日"
如果你的電腦上顯示是"星期日"
那就將Replace的字串改成"星期"即可
Ar(s) = Array(d, Replace(Format(mydate, "aaa"), "星期", ""))
或
Ar(s) = Array(d, Right(Format(mydate, "aaa"),1))

Hsieh

回復 25# 周大偉

1. Sub Ex()
   
2. Dim y$, Ar(), w$, j%, i%
   
3. y = InputBox("輸入年分", , Year(Date))
   
4. If y = "" Then Exit Sub
   
5. For i = 1 To 12
   
6.    d = Day(DateAdd("m", 1, DateSerial(CInt(y), i, 1)) - 1)
   
7.    ReDim Preserve Ar(1 To 2, 1 To d)
   
8.    For j = 1 To d
   
9.    w = Replace(Format(Weekday(DateSerial(CInt(y), i, j), 2), "aaa"), "週", "")
   
10.       Ar(1, j) = j
    
11.       Ar(2, j) = w
    
12.    Next
    
13.    Sheets(i & "月").[G2:AK3] = ""
    
14.    Sheets(i & "月").[G2].Resize(2, d) = Ar
    
15.    Erase Ar
    
16. Next
    
17. End Sub

複製代碼