12
返回列表 上一主題 發帖

[發問] 如何利用迴圈或其他方式選取日期範圍自動輸入inputbox

ten999

帖子
38 
主題
19 
精華
0 
積分
84 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
taichung 
註冊時間
2011-7-6 
最後登錄
2022-3-29 
11# 跳轉到 »
發表於 2011-7-23 08:33 | 只看該作者
本帖最後由 GBKEE 於 2011-7-23 09:09 編輯

回復 10# Hsieh

謝謝Hsieh回復及教學讓我解決問題.
請問另外思考方式:是否可利用建立sheet工作表方式(參考證交所內有年度休市日期)將各年度(如:2002-2011年)特定假日製作表格讓程式執行過程可先判斷其表格內範圍值是否相同再執行.(因為年度假日中有部分彈性休假及補交易日因素,同時像端午 中秋 農曆春節各年度日期並不同)
謝謝
日期表格如附件(非交易日不開盤 補交易日(經常是利用星期六)
saveCSVfmURL(1).rar (14.61 KB)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2011-7-23 11:03 | 只看該作者
回復 11# ten999
試試看
  1. Sub testCr()
  2.     Dim selDate As Date, 起始日期 As Date, 結束日期 As Date
  3.     Dim Rng As Range
  4.     On Error Resume Next    '表示當一個執行階段錯誤產生時，程式控制立刻到發生錯誤陳述式接下去的陳述式，而繼續執行下去
  5.     起始日期 = InputBox("輸入起始日期")
  6.     If 起始日期 = False Then Exit Sub
  7.     結束日期 = InputBox("輸入 結束日期")
  8.     If 結束日期 = False Then Exit Sub
  9.     On Error GoTo 0             '停止現在程序裏任何已啟動的錯誤處理程式
  10.     For selDate = 起始日期 To 結束日期
  11.         Set Rng = Sheets("非交易日").Cells.Find(selDate, LookIn:=xlValues)  '在非交易日中尋找日期
  12.         If Rng Is Nothing Then                                              '非交易日中找不到日期
  13.             Select Case Weekday(selDate)
  14.                 Case 2 To 6                                                 '週一到週五
  15.                     saveCSVfmURL selDate
  16.                 Case Else    '-> Case 1 , 7                                 '假日
  17.                     Set Rng = Sheets("補交易日").Cells.Find(selDate, LookIn:=xlValues)     '假日中尋找補交易日日期
  18.                     If Not Rng Is Nothing Then saveCSVfmURL selDate         '找到日期
  19.             End Select
  20.         End If
  21.     Next
  22. End Sub
複製代碼

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
13#
發表於 2011-7-23 11:04 | 只看該作者
回復 11# ten999
上班日、休假日在台灣實行的是有點亂
但是，就程式設計而言，當無規則可循時就用列表解決
那麼列表的格式就攸關城市運行是否順暢
不規則的條件要用列表的意義在於容易找出規則
但你的設計反而讓列表複雜，建議只用2欄位來記錄假日
  1. Sub testCr()
  2. Dim selDate As Date, 起始日期 As Date, 結束日期 As Date
  3. 起始日期 = InputBox("輸入起始日期", , 2001 / 12 / 29)
  4. 結束日期 = InputBox("輸入 結束日期", , Date)
  5. For selDate = 起始日期 To 結束日期
  6. If IsError(Application.Match(CDbl(selDate), Sheets("交易異動表").[A:A], 0)) Then
  7.    If Weekday(selDate, 2) < 6 Or IsNumeric(Application.Match(selDate, Sheets("交易異動表").[B:B], 0)) Then
  8.       saveCSVfmURL selDate
  9.    End If
  10. End If
  11. Next
  12. End Sub
複製代碼
學海無涯_不恥下問

TOP

ten999

帖子
38 
主題
19 
精華
0 
積分
84 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
taichung 
註冊時間
2011-7-6 
最後登錄
2022-3-29 
14#
發表於 2011-7-23 15:12 | 只看該作者
回復 13# Hsieh


謝謝 Hsieh 及GBKEE兩位教導 !
請教如何將一個資料夾內很多筆的csv檔(名稱為日期樣式 20110103ms.csv  20110104ms.csv-------)依 年度 月份 第幾周分門別類
例如 c:/test/2011/01/第一周,c:/test/2011/01/第二周 --- c:/test/2011/02/第一周 c:/test/2011/02/第二周-----
因為需要觀察長短期成交量金額
謝謝

TOP

ten999

帖子
38 
主題
19 
精華
0 
積分
84 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
taichung 
註冊時間
2011-7-6 
最後登錄
2022-3-29 
15#
發表於 2011-7-27 15:17 | 只看該作者
利用下列vba將數千個csv檔(同一資料夾內)依年度月份建立資料夾
想請問程式碼中#6列A = Mid(F, InStr(F, "2004"))  中2004為手動輸入(程式碼編輯視窗/偵錯/逐行) ,是否有其他方式可改善!
謝謝         
Sub Ex()  
    Dim fs As Object, F As Object, A$, MyPath$
    MyPath = ThisWorkbook.Path                           
   Set fs = CreateObject("Scripting.FileSystemObject")   
    For Each F In fs.GetFolder(MyPath).Files
        If InStr(F, ".csv") Then   
            A = Mid(F, InStr(F, "2004"))            
            'A = Replace(A, ".csv", "")               
           ' A = Replace(A, "-", "\")               
            If fs.FolderExists(MyPath & "\" & Mid(A, 1, 4)) = False Then
             ChDir MyPath                        
            MkDir MyPath & "\" & Mid(A, 1, 4)              
            End If
            If fs.FolderExists(MyPath & "\" & Mid(A, 1, 4) & "\" & Mid(A, 5, 2)) = False Then                      ChDir MyPath & "\" & Mid(A, 1, 4)
                MkDir MyPath & "\" & Mid(A, 1, 4) & "\" & Mid(A, 5, 2)
            End If
            'If fs.FolderExists(MyPath & "\" & A) = False Then   
                'ChDir MyPath & "\" & Mid(A, 1, 7)
               ' MkDir MyPath & "\" & A
            'End If
            fs.moveFile F, MyPath & "\" & Mid(A, 1, 4) & "\" & Mid(A, 5, 2) & "\"  
        End If
    Next
    ChDir MyPath                                   
End Sub

TOP

ten999

帖子
38 
主題
19 
精華
0 
積分
84 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
taichung 
註冊時間
2011-7-6 
最後登錄
2022-3-29 
16#
發表於 2011-7-30 16:34 | 只看該作者
回復 15# ten999
參考 Hsieh 教學  檔案操作範例 (Dir / Filesystem Object  Dir 進階應用範例列出指定目錄之下所有的子資料夾內容)
將數個資料夾(2004\04\200404total.xls -- 2004\05\200405total.xls--2005\01\200501total.xls----下數個特定檔案(*\*\*total.xls)列表於sheet1內!

請問如何依序開啟這些檔案(*total.xls)將固定的程式碼(附件內模組:module3)寫入這些檔案內執行特定工作後關閉!
謝謝!

saveCSVfmURL(1).rar (25.27 KB)

TOP

        靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。
12
返回列表 上一主題