- 帖子
- 559
- 主題
- 58
- 精華
- 0
- 積分
- 626
- 點名
- 0
- 作業系統
- win8
- 軟體版本
- office2013
- 閱讀權限
- 50
- 性別
- 男
- 來自
- TW
- 註冊時間
- 2010-11-22
- 最後登錄
- 2024-6-14
|
4#
發表於 2012-3-2 12:10
| 只看該作者
回復 3# g93353
有再稍微看過樓主要求~ 好像是要把每月的1號帶出來~
可使用下列的方式~
若不用帶出每月1號的資料~ 就採用上面第一個模組~- Sub EX()
- A = InputBox("請輸入年份")
- B = InputBox("請輸入月份")
- If Len(A) = 4 And (Len(B) = 1 Or Len(B) = 2) Then
- A1 = DateValue(A & "年" & "1月" & "1日")
- A2 = DateValue(A & "年" & "2月" & "1日")
- A3 = DateValue(A & "年" & "3月" & "1日")
- A4 = DateValue(A & "年" & "4月" & "1日")
- A5 = DateValue(A & "年" & "5月" & "1日")
- A6 = DateValue(A & "年" & "6月" & "1日")
- I = 0
- Sheet1.Rows("1:1").ClearContents
- Select Case B
- Case 1
- Do Until Month(A1 + I) > 1
- If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 1 And Day(A1 + I) = 1) Then
- If Sheet1.Range("A1") = "" Then
- Sheet1.Range("A1") = A1 + I
- Else
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
- End If
- End If
- I = I + 1
- Loop
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A2
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A3
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
- Case 2
- Do Until Month(A1 + I) > 2
- If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 2 And Day(A1 + I) = 1) Then
- If Sheet1.Range("A1") = "" Then
- Sheet1.Range("A1") = A1 + I
- Else
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
- End If
- End If
- I = I + 1
- Loop
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A3
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
- Case 3
- Do Until Month(A1 + I) > 3
- If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 3 And Day(A1 + I) = 1) Then
- If Sheet1.Range("A1") = "" Then
- Sheet1.Range("A1") = A1 + I
- Else
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
- End If
- End If
- I = I + 1
- Loop
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
- Case 4
- Do Until Month(A1 + I) > 4
- If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 4 And Day(A1 + I) = 1) Then
- If Sheet1.Range("A1") = "" Then
- Sheet1.Range("A1") = A1 + I
- Else
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
- End If
- End If
- I = I + 1
- Loop
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
- Case 5
- Do Until Month(A1 + I) > 5
- If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 5 And Day(A1 + I) = 1) Then
- If Sheet1.Range("A1") = "" Then
- Sheet1.Range("A1") = A1 + I
- Else
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
- End If
- End If
- I = I + 1
- Loop
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
- Case 6
- Do Until Month(A1 + I) > 6
- If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 6 And Day(A1 + I) = 1) Then
- If Sheet1.Range("A1") = "" Then
- Sheet1.Range("A1") = A1 + I
- Else
- Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
- End If
- End If
- I = I + 1
- Loop
- End Select
- End If
- End Sub
複製代碼 |
|