返回列表 上一主題 發帖

隨時新增欄位問題

隨時新增欄位問題

想請問各位高手們


小弟今天分別在A1 B1 C1 D1 E1 F1 欄位 分別打上了每個月的第一天

也就是一月一日 至 六月一日

小弟想製作一個輸入數字並且按下按鈕後  就能夠以輸入的數字來分割出前面幾個月 每週的星期日

用說的可能很難理解 舉例一下

        A       B      C       D        E      F
1     1/1   2/1   3/1   4/1    5/1   6/1

假設今天輸入數字 :  2
代表前面兩個月都必須顯示出一月及二月的每個星期日 日期
以2012年來說
就變成這樣
        A         B       C          D           E           F         G        H          I           J         K         L        M       N      
1    1/1    1/8     1/15    1/22     1/29     2/1     2/4     2/11    2/18   2/25    3/1     4/1     5/1    6/1

以此類推
若輸入的數字是3  那就顯示出前面三個月每個月的星期日的日期

想請問各位高手  由於輸入的數字不一定  每年每週的星期日也都不同
請教該如何寫出巨集>"< 困擾很久了 還請各位解答!!!!
WOW

回復 1# g93353

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

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

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

  95. End Select

  96. End If


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

TOP

先來研究看看  謝謝hugh0620大大!!!!!!!!!
WOW

TOP

回復 3# g93353

有再稍微看過樓主要求~ 好像是要把每月的1號帶出來~
可使用下列的方式~
若不用帶出每月1號的資料~ 就採用上面第一個模組~
  1. Sub EX()
  2. A = InputBox("請輸入年份")
  3. B = InputBox("請輸入月份")

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

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

  95. End Select

  96. End If


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

TOP

感謝hugh0620 的回覆  小弟試過後發現 每個月的一號有些月份不會顯示出來說  
像2011年就不行了>"<
WOW

TOP

本帖最後由 register313 於 2012-3-2 15:10 編輯
  1. Sub YY()
  2. Rows("2") = ""
  3. MX = InputBox("請輸入月份數")
  4. For M = 1 To MX
  5.   First = Cells(1, M) + (7 - Weekday(Cells(1, M), 2))
  6.   [A2].Offset(0, C) = First
  7.   C = C + 1
  8.   Do While Month(First + 7) = Month(Cells(1, M))
  9.      [A2].Offset(0, C) = First + 7
  10.      First = First + 7
  11.      C = C + 1
  12.   Loop
  13. Next M
  14. If MX <> 6 Then
  15.    Cells(1, MX + 1).Resize(1, 6 - MX).Copy [A2].Offset(0, C)
  16. End If
  17. Range([A2], [IV2].End(xlToLeft)).NumberFormatLocal = "m/d;@"
  18. End Sub
複製代碼

TOP

本帖最後由 hugh0620 於 2012-3-2 13:42 編輯

回復 5# g93353

若樓主您的是該年度整年份的資料~  (僅限一個年度)
這樣下面的寫法~ 可以得到你需要的結果~

若您需要的設定某一個區間的資料~ 寫法又不一樣了~
case by case
  1. Sub EX()
  2. Dim B As Integer
  3. A = InputBox("請輸入年份")
  4. B = InputBox("請輸入月份")

  5. If Len(A) = 4 And (Len(B) = 1 Or Len(B) = 2) Then
  6. A1 = DateValue(A & "年" & "1月" & "1日")
  7. I = 0
  8. Sheet1.Rows("1:1").ClearContents
  9.     Do Until Month(A1 + I) > B
  10.        If Weekday(A1 + I, 2) = 7 Or (Month(A1 + I) = 1 And Day(A1 + I) = 1) Then
  11.           If Sheet1.Range("A1") = "" Then
  12.              Sheet1.Range("A1") = A1 + I
  13.           Else
  14.              Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = A1 + I
  15.           End If
  16.        End If
  17.     I = I + 1
  18.     Loop
  19.     If B <> 12 Then
  20.        For I = B + 1 To 12
  21.        Sheet1.Range("IV1").End(xlToLeft).Offset(0, 1) = DateValue(A & "年" & I & "月" & "1日")
  22.     Next
  23.     End If
  24. End If

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

TOP

謝謝 register313 跟 hugh0620 大大
想請問一下 hugh0620 大大

小弟已經自行把每月的第一天都先打在欄位上了(有可能跨年份 EX : 從2011 到2012)
那這樣寫法要如何作修改?
WOW

TOP

回復 8# g93353
  1. Sub YY()
  2. Rows("2") = ""
  3. MX = InputBox("請輸入月份數")
  4. For M = 1 To MX
  5.   First = Cells(1, M) + (7 - Weekday(Cells(1, M), 2))
  6.   [A2].Offset(0, C) = First
  7.   C = C + 1
  8.   Do While Month(First + 7) = Month(Cells(1, M))
  9.      [A2].Offset(0, C) = First + 7
  10.      First = First + 7
  11.      C = C + 1
  12.   Loop
  13. Next M
  14. Cells(1, MX + 1).Resize(1, 6 - MX).Copy [A2].Offset(0, C)
  15. Range([A2], [IV2].End(xlToLeft)).NumberFormatLocal = "m/d;@"
  16. End Sub
複製代碼

TOP

本帖最後由 g93353 於 2012-3-2 16:01 編輯

謝謝register313  
您跟 hugh0620 大大寫法都是輸入年月份後會自動跑出
小弟已經分別把每個月1號都各別寫在A1 到 F1(假設是1到6月)
而輸入的數字是指前面(數字)個月都必須顯示出星期日(從每個月的1號後面依序顯示出)
大大們的作法都部不會有新增欄位的問題
小弟已先將每個月的第一天先打好
這樣欄位的新增就會不固定
所以麻煩再請教各位了
先前敘述有點糢糊  不好意思了>"<
WOW

TOP

        靜思自在 : 君子立恆志,小人恆立志。
返回列表 上一主題