返回列表 上一主題 發帖

[發問] 請問該如何批次匯入不同日期資料至EXCEL？

j1221

帖子
50 
主題
10 
精華
0 
積分
69 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-6-21 
最後登錄
2015-1-11 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-5-11 23:48 | 只看該作者

[發問] 請問該如何批次匯入不同日期資料至EXCEL？

各位好，

不好意思又來麻煩大家了。最近在試著改寫以【程式交易聚寶盆】裡面CLCY大分享的期交所轉檔檔案，試著把原先只能一次輸入一天的EXCEL改寫成可以批次輸入多天的版本（比如說從一個合約月份的開倉日至結算日），但是一直不成功。
也就是說我想要從期交所提供的盤後每筆交易資料（.rpt檔）批次輸入至Excel中（Excel 2010)，比如說從2011-12-15, 2011-12-16,......2012-01-12, 2012-01-13 等等

請先讓我附上我的code，再說明我的問題。
  1. Public Sub CommandButton1_Click()
  2. Dim FilePath As String, FileName As String

  4. Dim Product As String, Contract As String
  5. Dim Hr As Long, Min As Long, Sec As Long

  7. iYear_s = Val(txtYear_start.Text)
  8. iYear_e = Val(txtYear_end.Text)
  9. iMonth_s = Val(txtMonth_start.Text)
  10. iMonth_e = Val(txtMonth_end.Text)
  11. iDay_s = Val(txtDay_start.Text)
  12. iDay_e = Val(txtDay_end.Text)

  14. For Z = iYear_s To iYear_e
  15.     For J = iMonth_s To iMonth_e
  16.         For K = iDay_s To iDay_e
  17.             'transform number into string
  18.             txtYear = Z & ""
  19.             txtMonth = J & ""
  20.             txtDay = K & ""
  21.             FilePath = ThisWorkbook.Path & "\"
  22.              'specify the file name to be "Daily_yyyy_mm_dd.rpt"
  23.             If J < 10 And K < 10 Then
  24.                 FileName = "Daily_" & txtYear & "_0" & txtMonth & "_0" & txtDay & ".rpt"
  25.             ElseIf J < 10 And K >= 10 Then
  26.                 FileName = "Daily_" & txtYear & "_0" & txtMonth & "_" & txtDay & ".rpt"
  27.             ElseIf J >= 10 And K < 10 Then
  28.                 FileName = "Daily_" & txtYear & "_" & txtMonth & "_0" & txtDay & ".rpt"
  29.             ElseIf J >= 10 And K >= 10 Then
  30.                 FileName = "Daily_" & txtYear & "_" & txtMonth & "_" & txtDay & ".rpt"
  31.             End If
  32.             Product = txtProduct.Text
  33.             Contract = txtContract.Text
  34.             ' count total number of worksheets
  35.             isheetsnumber = ThisWorkbook.Sheets.Count
  36.             ' free the file number for input
  37.             iFNumber = FreeFile
  38.             ' resume if the .rpt file doesn't exist
  39. On Error GoTo errTrap
  40.             'input .rpt file
  41.             Open FilePath & FileName For Input As #iFNumber
  42.             SheetsName = Mid(FileName, 7, 10) & "f"
  43.             'small loop to test if the worksheet exists, exists =true otherwise false
  44.             For iM = 1 To isheetsnumber
  45.             If ThisWorkbook.Worksheets(iM).Name = SheetsName & "" Then ' &"" transform the number to string
  46.                 Sheets_Exist = True: Exit For
  47.             Else
  48.                 Sheets_Exist = False
  49.             End If
  50.             Next iM
  51.     'if sheet does not exist, then add one
  52.     If Sheets_Exist = False Then
  53.             Worksheets.Add.Name = SheetsName
  54.             ' move to the end
  55.             ActiveSheet.Move After:=Sheets(isheetsnumber)
  56.             N = 1
  57.             While Not EOF(1)
  58.                 Input #iFNumber, A(N, 1), A(N, 2), A(N, 3), A(N, 4), A(N, 5), A(N, 6), A(N, 7), A(N, 8)
  59.                 If N = 1 Then
  60.                     Sheets(SheetsName).Cells(1, 1) = A(1, 4)
  61.                     Sheets(SheetsName).Cells(1, 2) = A(1, 5)
  62.                     Sheets(SheetsName).Cells(1, 3) = A(1, 6)
  63.                     N = N + 1
  64.                 End If
  65.                 If A(N, 2) = Product And A(N, 3) = Contract Then
  66.                     Sec = Val(Left(Right(Str(A(N, 4)), 2), 2))
  67.                     Min = Val(Left(Right(Str(A(N, 4)), 4), 2))
  68.                     Hr = Val(Left(Right(Str(A(N, 4)), 6), 2))
  69.                     A(N, 9) = Str((Hr * 3600 + Min * 60 + Sec) - 31500)
  70.                     Sheets(SheetsName).Cells(N, 1).Value = Val(A(N, 4))
  71.                     Sheets(SheetsName).Cells(N, 2).Value = Val(A(N, 5))
  72.                     Sheets(SheetsName).Cells(N, 3).Value = Val(A(N, 6))
  73.                     Sheets(SheetsName).Cells(N, 4).Value = Val(A(N, 9))
  74.                     N = N + 1
  75.                 End If
  76.             Wend
  77.             Close 1
  78.             N = N - 2
  79.      End If
  80.             
  81.             MsgBox ("Total amount of data is " & Str(N))
  82. errTrap:
  83.    Resume Conti

  85. Conti:
  86.         Next K
  87.      Next J
  88.    
  89. Next Z
  90. End Sub
複製代碼
如果是同一個月份或是年份的話沒有問題，但是出現跨月的話，就出問題了。主要是因為一但跨月，日期就會從1號開始，在For Next 回圈裡面沒辦法處理，我曾經也是著用block If的判斷式想去分辨不同的情況，但是好像用If 之後沒辦法用For 這樣excel會告訴我“有If 但沒有End If"

請問有沒有辦法解決（或改寫）這個問題呢？ 謝謝各位

PS: 原始檔案有點過大，無法附加，麻煩至 http://min.us/mx0lbUjTp 下載 （轉檔部份的Code作者為【程式交易聚寶盆】的CLCY大）
收藏 分享
我愛麻辣家族討論區！！

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
2#
發表於 2012-5-16 11:48 | 只看該作者
回復 1# j1221

     但是好像用If 之後沒辦法用For 這樣excel會告訴我“有If 但沒有End If"
      樓主~ 這個問題是您在撰寫時~ 有寫IF 但沒有寫結尾Eed IF~      
     樓主的觀念的對的呀~若是誇月~ 我的寫法~ 直覺是用IF去判斷~
      因此~ 樓主 要不要再試一下~ 你原始的寫法~ 應該就可以解決跨月的問題~
學習才能提升自己

TOP

j1221

帖子
50 
主題
10 
精華
0 
積分
69 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-6-21 
最後登錄
2015-1-11 
3#
發表於 2012-5-16 20:49 | 只看該作者
回復 2# hugh0620

謝謝您的回覆，但是其實我就是利用這樣寫的，我的方法如下
  1. If iYear_s = iYear_e Then
  2.     Z = iYear_s
  3.     For J = iMonth_s To iMonth_e
  4.         If J = iMonth_s Then
  5.             For K = iDay_s To 31
  6.         Else
  7.             For K = 1 To iDay_e
  8.         End If
  9. End If
複製代碼
Excel 跳出的還是 “有Else 沒有If“ 請問問題是出在哪裡呢？？
我愛麻辣家族討論區！！

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
4#
發表於 2012-5-17 09:03 | 只看該作者
本帖最後由 hugh0620 於 2012-5-17 09:27 編輯

回復 3# j1221


    你有寫for 但是少了next~ 當然會產生錯誤呀~
    要在檢視一下~ 你寫的是不是一對一對的~
    if  
         for
               for
                           if    
                           end  if
               next
         next
     end if

檢查過你發文的程式碼~ 沒有問題~

要不要把你修改過後的完整程式碼po上來看看呢
學習才能提升自己

TOP

j1221

帖子
50 
主題
10 
精華
0 
積分
69 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-6-21 
最後登錄
2015-1-11 
5#
發表於 2012-5-17 21:13 | 只看該作者
回復 4# hugh0620


    謝謝您的幫忙，我想我應該在這邊沒有寫錯吧....以下為我的code
  1. Public Sub CommandButton1_Click()
  2. Dim FilePath As String, FileName As String

  4. Dim Product As String, Contract As String
  5. Dim Hr As Long, Min As Long, Sec As Long

  7. iYear_s = Val(txtYear_start.Text)
  8. iYear_e = Val(txtYear_end.Text)
  9. iMonth_s = Val(txtMonth_start.Text)
  10. iMonth_e = Val(txtMonth_end.Text)
  11. iDay_s = Val(txtDay_start.Text)
  12. iDay_e = Val(txtDay_end.Text)

  14. If iYear_s = iYear_e Then
  15.     Z = iYear_s
  16.     For J = iMonth_s To iMonth_e
  17.         If J = iMonth_s Then
  18.             For K = iDay_s To 31
  19.         Else
  20.             For K = 1 To iDay_e
  21.         End If
  22. End If
  23.             'transform number into string
  24.             txtYear = Z & ""
  25.             txtMonth = J & ""
  26.             txtDay = K & ""
  27.             FilePath = ThisWorkbook.Path & "\"
  28.              'specify the file name to be "Daily_yyyy_mm_dd.rpt"
  29.             If J < 10 And K < 10 Then
  30.                 FileName = "Daily_" & txtYear & "_0" & txtMonth & "_0" & txtDay & ".rpt"
  31.             ElseIf J < 10 And K >= 10 Then
  32.                 FileName = "Daily_" & txtYear & "_0" & txtMonth & "_" & txtDay & ".rpt"
  33.             ElseIf J >= 10 And K < 10 Then
  34.                 FileName = "Daily_" & txtYear & "_" & txtMonth & "_0" & txtDay & ".rpt"
  35.             ElseIf J >= 10 And K >= 10 Then
  36.                 FileName = "Daily_" & txtYear & "_" & txtMonth & "_" & txtDay & ".rpt"
  37.             End If
  38.             Product = txtProduct.Text
  39.             Contract = txtContract.Text
  40.             ' count total number of worksheets
  41.             isheetsnumber = ThisWorkbook.Sheets.Count
  42.             ' free the file number for input
  43.             iFNumber = FreeFile
  44.             ' resume if the .rpt file doesn't exist
  45. On Error GoTo errTrap
  46.             'input .rpt file
  47.             Open FilePath & FileName For Input As #iFNumber
  48.             SheetsName = Mid(FileName, 7, 10) & "f"
  49.             'small loop to test if the worksheet exists, exists =true otherwise false
  50.             For iM = 1 To isheetsnumber
  51.             If ThisWorkbook.Worksheets(iM).Name = SheetsName & "" Then ' &"" transform the number to string
  52.                 Sheets_Exist = True: Exit For
  53.             Else
  54.                 Sheets_Exist = False
  55.             End If
  56.             Next iM
  57.     'if sheet does not exist, then add one
  58.     If Sheets_Exist = False Then
  59.             Worksheets.Add.Name = SheetsName
  60.             ' move to the end
  61.             ActiveSheet.Move After:=Sheets(isheetsnumber)
  62.             N = 1
  63.             While Not EOF(1)
  64.                 Input #iFNumber, A(N, 1), A(N, 2), A(N, 3), A(N, 4), A(N, 5), A(N, 6), A(N, 7), A(N, 8)
  65.                 If N = 1 Then
  66.                     Sheets(SheetsName).Cells(1, 1) = A(1, 4)
  67.                     Sheets(SheetsName).Cells(1, 2) = A(1, 5)
  68.                     Sheets(SheetsName).Cells(1, 3) = A(1, 6)
  69.                     N = N + 1
  70.                 End If
  71.                 If A(N, 2) = Product And A(N, 3) = Contract Then
  72.                     Sec = Val(Left(Right(Str(A(N, 4)), 2), 2))
  73.                     Min = Val(Left(Right(Str(A(N, 4)), 4), 2))
  74.                     Hr = Val(Left(Right(Str(A(N, 4)), 6), 2))
  75.                     A(N, 9) = Str((Hr * 3600 + Min * 60 + Sec) - 31500)
  76.                     Sheets(SheetsName).Cells(N, 1).Value = Val(A(N, 4))
  77.                     Sheets(SheetsName).Cells(N, 2).Value = Val(A(N, 5))
  78.                     Sheets(SheetsName).Cells(N, 3).Value = Val(A(N, 6))
  79.                     Sheets(SheetsName).Cells(N, 4).Value = Val(A(N, 9))
  80.                     N = N + 1
  81.                 End If
  82.             Wend
  83.             Close 1
  84.             N = N - 2
  85.      End If
  86.             
  87.             MsgBox ("Total amount of data is " & Str(N))
  88. errTrap:
  89.    Resume Conti

  91. Conti:
  92.         Next K
  93.      Next J
  94.    

  96. End Sub
複製代碼
我愛麻辣家族討論區！！

TOP

hugh0620
　暱稱: VBA向前衝

高中生Rank: 3Rank: 3

帖子
550 
主題
55 
精華
0 
積分
614 
點名
0  
作業系統
win8 
軟體版本
office2013 
閱讀權限
50 
性別
男 
來自
TW 
註冊時間
2010-11-22 
最後登錄
2024-4-23 
6#
發表於 2012-5-18 08:17 | 只看該作者
本帖最後由 hugh0620 於 2012-5-18 08:21 編輯

回復 5# j1221

     還真的寫錯了唷~
If iYear_s = iYear_e Then
    Z = iYear_s
    For J = iMonth_s To iMonth_e        
          If J = iMonth_s Then
            For K = iDay_s To 31
            
            NEXT K  
      Else
            For K = 1 To iDay_e

            next K
        End If
    next J
End If

按您原始的寫法~ 執行到For J = iMonth_s To iMonth_e 這一句~
如何跳到next J呢~  不可能唷~ 中間有END IF
在程式執行時~ 就會錯誤了~
你可以在IF .....   END IF 中間放在For  ...  Next
但不能把  next 放在 end  if後面~
學習才能提升自己

TOP

j1221

帖子
50 
主題
10 
精華
0 
積分
69 
點名
0  
作業系統
Windows XP 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-6-21 
最後登錄
2015-1-11 
7#
發表於 2012-5-18 10:42 | 只看該作者
回復 6# hugh0620

謝謝您的回覆!!

當初我是想要先判斷之後再開始回圈，也就是說我不想複製兩次重複的code (進入for之後的那部分) ，因為這樣整個程序會變得很長。

請問有辦法做到這樣嗎?
我愛麻辣家族討論區！！

TOP

        靜思自在 : 要用心，不要操心、煩心。
返回列表 上一主題