12
返回列表 上一主題 發帖

隨時新增欄位問題

g93353

帖子
40 
主題
17 
精華
0 
積分
62 
點名
0  
作業系統
windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-27 
最後登錄
2014-11-18 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-3-2 10:29 | 只看該作者

隨時新增欄位問題

想請問各位高手們


小弟今天分別在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

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
14#
發表於 2012-3-3 10:35 | 只看該作者
回復 13# hugh0620
基本上樓主的問題有一些不清楚
是要輸入處理幾個月，然後進行欄位重編的話，程式應可行
若是指定那些月份，那就要輸入2個參數，起始月份及處理月數或結束月份
所以，這只是提供另一種思路參考，至於如何符合個人需求，還是要自己動腦
學海無涯_不恥下問

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

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


    H大大~ 小弟有測試過您的程式碼~
    若像樓主有跨年度的情況~
    ex. 若資料從20120101~20131201的話~
    輸入2月份
    程式碼僅會抓取 201201~201202的資料處理~
    因為程式碼並未針對從哪一個年月的資料來處理~
    而是僅處理第一個抓取的月份~
學習才能提升自己

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
12#
發表於 2012-3-3 00:00 | 只看該作者
回復 1# g93353
  1. Sub Ex()
  2. Dim k%, Ar(), j%, s%, ky, d As Object
  3. k = InputBox("輸入月數", , 3)
  4. Set d = CreateObject("Scripting.Dictionary")
  5. For Each A In Rows(1).SpecialCells(xlCellTypeConstants)
  6.    d(Format(A, "yyyy/mm")) = DateValue(Format(A, "yyyy/mm/1"))
  7. Next
  8. For Each ky In d.keys
  9. j = j + 1
  10. If j <= k Then
  11.    For i = d(ky) To DateAdd("M", 1, d(ky)) - 1
  12.    If (Day(i) = 1 Or Weekday(i, vbMonday) = 7) Then
  13.       ReDim Preserve Ar(s)
  14.       Ar(s) = i
  15.       s = s + 1
  16.    End If
  17.    Next
  18. Else
  19.       ReDim Preserve Ar(s)
  20.       Ar(s) = d(ky)
  21.       s = s + 1
  22. End If
  23. Next
  24. Rows(1) = ""
  25. [A1].Resize(, s) = Ar
  26. End Sub
複製代碼
學海無涯_不恥下問

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
11#
發表於 2012-3-2 16:29 | 只看該作者
回復 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

g93353

帖子
40 
主題
17 
精華
0 
積分
62 
點名
0  
作業系統
windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-27 
最後登錄
2014-11-18 
10#
發表於 2012-3-2 15:45 | 只看該作者
本帖最後由 g93353 於 2012-3-2 16:01 編輯

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

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
9#
發表於 2012-3-2 14:57 | 只看該作者
回復 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

帖子
40 
主題
17 
精華
0 
積分
62 
點名
0  
作業系統
windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-12-27 
最後登錄
2014-11-18 
8#
發表於 2012-3-2 14:48 | 只看該作者
謝謝 register313 跟 hugh0620 大大
想請問一下 hugh0620 大大

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

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
559 
主題
58 
精華
0 
積分
626 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-6-14 
7#
發表於 2012-3-2 13:36 | 只看該作者
本帖最後由 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("請輸入月份")

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

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

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
6#
發表於 2012-3-2 13:24 | 只看該作者
本帖最後由 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

        靜思自在 : 站在半路，比走到目標更辛苦。
12
返回列表 上一主題