返回列表 上一主題 發帖

隨時新增欄位問題

本帖最後由 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

回復 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

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

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大,小人氣大。
返回列表 上一主題