一個星期天的問題

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

28^#

發表於 2011-10-9 09:44 | 只看該作者

hsieh大大 oobord大大,
衷心謝過两位版主大大回應, 祝願健康快樂...

oobird

　頭銜: 街友一族

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

27^#

發表於 2011-10-8 23:55 | 只看該作者

Sub Ex()
Dim y%, m%, n%, d%
y = [am1]
For m = 1 To 12
With Sheets(m & "月")
.[g2:ak3] = ""
n = Day(DateSerial(y, m + 1, 1) - 1)
ReDim arr(1 To 2, 1 To n)
For d = 1 To n
arr(1, d) = d
arr(2, d) = Right(Application.Text(DateSerial(y, m, d), "aaa"), 1)
Next
.[g2].Resize(2, n) = arr
End With
Next
End Sub

複製代碼

aa.rar (25.32 KB)

Hsieh

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

26^#

發表於 2011-10-8 23:38 | 只看該作者

回復 25# 周大偉

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

複製代碼

學海無涯_不恥下問

周大偉

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

25^#

發表於 2011-10-8 22:45 | 只看該作者

Hsieh版主大大,
先行謝過早前於這帖子的回覆, 有一疑問, vba程式中可否變為附件中, 按下按鈕, 同時把12張月份工作表星期及日期變更, 如可以的話, 的確節省了很多時間, 謝謝!!

aa.rar (24.05 KB)

317

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

24^#

發表於 2011-6-30 01:28 | 只看該作者

本帖最後由 317 於 2011-6-30 07:25 編輯

真是大大所說, 版本問題,
在此謝過大大, 祝願快樂, 感恩..

Hsieh

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

23^#

發表於 2011-6-29 23:33 | 只看該作者

或

本帖最後由 Hsieh 於 2011-6-30 08:09 編輯

回復 22# 317

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

學海無涯_不恥下問

317

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

22^#

發表於 2011-6-29 23:17 | 只看該作者

本帖最後由 317 於 2011-6-29 23:20 編輯

Hsieh大大, 安好..
已把程式轉成 Ar(s) = Array(d, Replace(Format(mydate, "aaa"), "週", "")), 但還是不成功, 原因何解..請大大協助

Sub Ex()

Dim Ar()

y = [Am1]

m = Val(ActiveSheet.Name)

If m < 1 Or m > 12 Then MsgBox "工作表名稱需要符合1~12月": Exit Sub

d = 1

mydate = DateSerial(y, m, d)

Do Until Month(mydate) <> m

   ReDim Preserve Ar(s)

   k = Format(mydate, "aaa")

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

   s = s + 1

   d = d + 1

   mydate = DateSerial(y, m, d)

Loop

[G2:AK3] = ""

[G2].Resize(2, s) = Application.Transpose(Ar)

End Sub

317

帖子: 248
主題: 55
精華: 0
積分: 334
點名: 0
作業系統: xp
軟體版本: 2003
閱讀權限: 20
註冊時間: 2010-7-24
最後登錄: 2023-2-2

21^#

發表於 2011-6-29 23:10 | 只看該作者

b]回復 18# Hsieh

大大好,
上文中恐表達不好, 現附上圖片, 可否把把程式改成圖1星期一星期二類轉換成下圖中單一數字, 一,二,三,四,五,六,日,謝謝, 祝快樂..

Hsieh

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 253
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

20^#

發表於 2011-6-29 23:05 | 只看該作者

回復 19# 317

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

學海無涯_不恥下問