12
返回列表 上一主題 發帖

隨時新增欄位問題

g93353

帖子
40 
主題
17 
精華
0 
積分
62 
點名
0  
作業系統
windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-27 
最後登錄
2014-11-18 
5# 跳轉到 »
發表於 2012-3-2 13:17 | 只看該作者
感謝hugh0620 的回覆  小弟試過後發現 每個月的一號有些月份不會顯示出來說  
像2011年就不行了>"<
WOW

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
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號的資料~ 就採用上面第一個模組~
  1. Sub EX()
  2. A = InputBox("請輸入年份")
  3. B = InputBox("請輸入月份")

  5. If Len(A) = 4 And (Len(B) = 1 Or Len(B) = 2) Then
  6. A1 = DateValue(A & "年" & "1月" & "1日")
  7. A2 = DateValue(A & "年" & "2月" & "1日")
  8. A3 = DateValue(A & "年" & "3月" & "1日")
  9. A4 = DateValue(A & "年" & "4月" & "1日")
  10. A5 = DateValue(A & "年" & "5月" & "1日")
  11. A6 = DateValue(A & "年" & "6月" & "1日")
  12. I = 0
  13. Sheet1.Rows("1:1").ClearContents
  14. Select Case B

  16. Case 1
  17.      Do Until Month(A1 + I) > 1
  18.         If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 1 And Day(A1 + I) = 1) Then
  19.            If Sheet1.Range("A1") = "" Then
  20.               Sheet1.Range("A1") = A1 + I
  21.            Else
  22.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  23.            End If
  24.         End If
  25.      I = I + 1
  26.      Loop
  27.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A2
  28.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A3
  29.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
  30.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  31.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  32. Case 2
  33.      Do Until Month(A1 + I) > 2
  34.         If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 2 And Day(A1 + I) = 1) Then
  35.            If Sheet1.Range("A1") = "" Then
  36.               Sheet1.Range("A1") = A1 + I
  37.            Else
  38.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  39.            End If
  40.         End If
  41.      I = I + 1
  42.      Loop
  43.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A3
  44.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
  45.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  46.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  47. Case 3
  48.      Do Until Month(A1 + I) > 3
  49.         If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 3 And Day(A1 + I) = 1) Then
  50.            If Sheet1.Range("A1") = "" Then
  51.               Sheet1.Range("A1") = A1 + I
  52.            Else
  53.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  54.            End If
  55.         End If
  56.      I = I + 1
  57.      Loop
  58.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
  59.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  60.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  61. Case 4
  62.      Do Until Month(A1 + I) > 4
  63.         If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 4 And Day(A1 + I) = 1) Then
  64.            If Sheet1.Range("A1") = "" Then
  65.               Sheet1.Range("A1") = A1 + I
  66.            Else
  67.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  68.            End If
  69.         End If
  70.      I = I + 1
  71.      Loop
  72.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  73.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  74. Case 5
  75.      Do Until Month(A1 + I) > 5
  76.         If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 5 And Day(A1 + I) = 1) Then
  77.            If Sheet1.Range("A1") = "" Then
  78.               Sheet1.Range("A1") = A1 + I
  79.            Else
  80.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  81.            End If
  82.         End If
  83.      I = I + 1
  84.      Loop
  85.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  86. Case 6
  87.      Do Until Month(A1 + I) > 6
  88.         If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 6 And Day(A1 + I) = 1) Then
  89.            If Sheet1.Range("A1") = "" Then
  90.               Sheet1.Range("A1") = A1 + I
  91.            Else
  92.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  93.            End If
  94.         End If
  95.      I = I + 1
  96.      Loop

  98. End Select

  100. End If


  103. End Sub
複製代碼
學習才能提升自己

TOP

g93353

帖子
40 
主題
17 
精華
0 
積分
62 
點名
0  
作業系統
windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-27 
最後登錄
2014-11-18 
3#
發表於 2012-3-2 12:00 | 只看該作者
先來研究看看  謝謝hugh0620大大!!!!!!!!!
WOW

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
2#
發表於 2012-3-2 11:51 | 只看該作者
回復 1# g93353

樓主~ 這個是可以被使用的~ 只是它的防呆~ 沒有寫的很好~
可以試看看~ 應該可以符合你要的結果~
  1. Sub EX()
  2. A = InputBox("請輸入年份")
  3. B = InputBox("請輸入月份")

  5. If Len(A) = 4 And (Len(B) = 1 Or Len(B) = 2) Then
  6. A1 = DateValue(A & "年" & "1月" & "1日")
  7. A2 = DateValue(A & "年" & "2月" & "1日")
  8. A3 = DateValue(A & "年" & "3月" & "1日")
  9. A4 = DateValue(A & "年" & "4月" & "1日")
  10. A5 = DateValue(A & "年" & "5月" & "1日")
  11. A6 = DateValue(A & "年" & "6月" & "1日")
  12. I = 0
  13. Sheet1.Rows("1:1").ClearContents
  14. Select Case B

  16. Case 1
  17.      Do Until Month(A1 + I) > 1
  18.         If Weekday(A1 + I, 2) = 7 Then
  19.            If Sheet1.Range("A1") = "" Then
  20.               Sheet1.Range("A1") = A1 + I
  21.            Else
  22.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  23.            End If
  24.         End If
  25.      I = I + 1
  26.      Loop
  27.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A2
  28.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A3
  29.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
  30.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  31.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  32. Case 2
  33.      Do Until Month(A1 + I) > 2
  34.         If Weekday(A1 + I, 2) = 7 Then
  35.            If Sheet1.Range("A1") = "" Then
  36.               Sheet1.Range("A1") = A1 + I
  37.            Else
  38.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  39.            End If
  40.         End If
  41.      I = I + 1
  42.      Loop
  43.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A3
  44.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
  45.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  46.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  47. Case 3
  48.      Do Until Month(A1 + I) > 3
  49.         If Weekday(A1 + I, 2) = 7 Then
  50.            If Sheet1.Range("A1") = "" Then
  51.               Sheet1.Range("A1") = A1 + I
  52.            Else
  53.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  54.            End If
  55.         End If
  56.      I = I + 1
  57.      Loop
  58.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A4
  59.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  60.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  61. Case 4
  62.      Do Until Month(A1 + I) > 4
  63.         If Weekday(A1 + I, 2) = 7 Then
  64.            If Sheet1.Range("A1") = "" Then
  65.               Sheet1.Range("A1") = A1 + I
  66.            Else
  67.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  68.            End If
  69.         End If
  70.      I = I + 1
  71.      Loop
  72.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A5
  73.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  74. Case 5
  75.      Do Until Month(A1 + I) > 5
  76.         If Weekday(A1 + I, 2) = 7 Then
  77.            If Sheet1.Range("A1") = "" Then
  78.               Sheet1.Range("A1") = A1 + I
  79.            Else
  80.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  81.            End If
  82.         End If
  83.      I = I + 1
  84.      Loop
  85.      Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A6
  86. Case 6
  87.      Do Until Month(A1 + I) > 6
  88.         If Weekday(A1 + I, 2) = 7 Then
  89.            If Sheet1.Range("A1") = "" Then
  90.               Sheet1.Range("A1") = A1 + I
  91.            Else
  92.               Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  93.            End If
  94.         End If
  95.      I = I + 1
  96.      Loop

  98. End Select

  100. End If


  103. End Sub
複製代碼
學習才能提升自己

TOP

        靜思自在 : 待人退一步，愛人寬一寸，就會活得很快樂。
12
返回列表 上一主題