各位好，
不好意思又來麻煩大家了。最近在試著改寫以【程式交易聚寶盆】裡面CLCY大分享的期交所轉檔檔案，試著把原先只能一次輸入一天的EXCEL改寫成可以批次輸入多天的版本（比如說從一個合約月份的開倉日至結算日），但是一直不成功。
也就是說我想要從期交所提供的盤後每筆交易資料（.rpt檔）批次輸入至Excel中（Excel 2010)，比如說從2011-12-15, 2011-12-16,......2012-01-12, 2012-01-13 等等
請先讓我附上我的code，再說明我的問題。- Public Sub CommandButton1_Click()
- Dim FilePath As String, FileName As String
- Dim Product As String, Contract As String
- Dim Hr As Long, Min As Long, Sec As Long
- iYear_s = Val(txtYear_start.Text)
- iYear_e = Val(txtYear_end.Text)
- iMonth_s = Val(txtMonth_start.Text)
- iMonth_e = Val(txtMonth_end.Text)
- iDay_s = Val(txtDay_start.Text)
- iDay_e = Val(txtDay_end.Text)
- For Z = iYear_s To iYear_e
- For J = iMonth_s To iMonth_e
- For K = iDay_s To iDay_e
- 'transform number into string
- txtYear = Z & ""
- txtMonth = J & ""
- txtDay = K & ""
- FilePath = ThisWorkbook.Path & "\"
- 'specify the file name to be "Daily_yyyy_mm_dd.rpt"
- If J < 10 And K < 10 Then
- FileName = "Daily_" & txtYear & "_0" & txtMonth & "_0" & txtDay & ".rpt"
- ElseIf J < 10 And K >= 10 Then
- FileName = "Daily_" & txtYear & "_0" & txtMonth & "_" & txtDay & ".rpt"
- ElseIf J >= 10 And K < 10 Then
- FileName = "Daily_" & txtYear & "_" & txtMonth & "_0" & txtDay & ".rpt"
- ElseIf J >= 10 And K >= 10 Then
- FileName = "Daily_" & txtYear & "_" & txtMonth & "_" & txtDay & ".rpt"
- End If
- Product = txtProduct.Text
- Contract = txtContract.Text
- ' count total number of worksheets
- isheetsnumber = ThisWorkbook.Sheets.Count
- ' free the file number for input
- iFNumber = FreeFile
- ' resume if the .rpt file doesn't exist
- On Error GoTo errTrap
- 'input .rpt file
- Open FilePath & FileName For Input As #iFNumber
- SheetsName = Mid(FileName, 7, 10) & "f"
- 'small loop to test if the worksheet exists, exists =true otherwise false
- For iM = 1 To isheetsnumber
- If ThisWorkbook.Worksheets(iM).Name = SheetsName & "" Then ' &"" transform the number to string
- Sheets_Exist = True: Exit For
- Else
- Sheets_Exist = False
- End If
- Next iM
- 'if sheet does not exist, then add one
- If Sheets_Exist = False Then
- Worksheets.Add.Name = SheetsName
- ' move to the end
- ActiveSheet.Move After:=Sheets(isheetsnumber)
- N = 1
- While Not EOF(1)
- 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)
- If N = 1 Then
- Sheets(SheetsName).Cells(1, 1) = A(1, 4)
- Sheets(SheetsName).Cells(1, 2) = A(1, 5)
- Sheets(SheetsName).Cells(1, 3) = A(1, 6)
- N = N + 1
- End If
- If A(N, 2) = Product And A(N, 3) = Contract Then
- Sec = Val(Left(Right(Str(A(N, 4)), 2), 2))
- Min = Val(Left(Right(Str(A(N, 4)), 4), 2))
- Hr = Val(Left(Right(Str(A(N, 4)), 6), 2))
- A(N, 9) = Str((Hr * 3600 + Min * 60 + Sec) - 31500)
- Sheets(SheetsName).Cells(N, 1).Value = Val(A(N, 4))
- Sheets(SheetsName).Cells(N, 2).Value = Val(A(N, 5))
- Sheets(SheetsName).Cells(N, 3).Value = Val(A(N, 6))
- Sheets(SheetsName).Cells(N, 4).Value = Val(A(N, 9))
- N = N + 1
- End If
- Wend
- Close 1
- N = N - 2
- End If
-
- MsgBox ("Total amount of data is " & Str(N))
- errTrap:
- Resume Conti
- Conti:
- Next K
- Next J
-
- Next Z
- End Sub
請問有沒有辦法解決（或改寫）這個問題呢？ 謝謝各位
PS: 原始檔案有點過大，無法附加，麻煩至 http://min.us/mx0lbUjTp 下載 （轉檔部份的Code作者為【程式交易聚寶盆】的CLCY大） |
發表於 2012-5-11 23:48
| 
