VBA練習——逐行讀取csv檔案
阿新 • • 發佈:2019-01-23
Sub qry_Click()
Dim currentFileDirectory
currentFileDirectory = Application.ActiveWorkbook.Path
Dim queryDataRowCnt As Integer
'獲取商戶訂單號
queryDataRowCnt = Application.Sheets(1).UsedRange.Rows.Count
Debug.Print "商戶訂單號條數為:" & queryDataRowCnt
Dim queryDatawechatRowIndex As Integer
queryDatawechatRowIndex = 2
Dim wechatFile
Dim fTextDir As String, wechatRowIndex As Integer, i As Integer
Dim paymentno As String
Dim wechatData As String
Dim resultCnt As Integer
resultCnt = 0
wechatFile = Dir(currentFileDirectory & "/*.csv") '返回對應路徑下第一個符合*.csv的檔名稱
If wechatFile = "" Then
MsgBox "請將微信商戶號下載的訂單檔案放至目錄" & currentFileDirectory
End If
Do While wechatFile <> "" '當返回的檔名為空時停止迴圈
wechatRowIndex = 1:
fTextDir = currentFileDirectory & "\" & wechatFile ' csv文字路徑
Debug.Print fTextDir
Open fTextDir For Input As #1 ' 匯入文字
Do While Not EOF(1) '逐行迴圈
Line Input #1, currLine '取第一行,並賦值
rowDataArr = Split(currLine, Chr(9))
If wechatRowIndex > 5 Then
wechatData = Right(rowDataArr(3), Len(rowDataArr(3)) - 1)
'Debug.Print "wechatData-->" & wechatData
'查詢商戶訂單號是否匹配
Do While queryDatawechatRowIndex <= queryDataRowCnt
paymentno = Application.Sheets(1).Cells(queryDatawechatRowIndex, 2).Value
'Debug.Print "queryValue->" & paymentno
If resultCnt >= queryDataRowCnt Then
GoTo LastLine
End If
If wechatData = paymentno Then
Debug.Print "商戶訂單號" & paymentno & "對應的現金券抵扣金為" & rowDataArr(16)
Application.Sheets(1).Cells(queryDatawechatRowIndex, 3).Value = rowDataArr(16)
resultCnt = resultCnt + 1
End If
queryDatawechatRowIndex = queryDatawechatRowIndex + 1
Loop
End If
queryDatawechatRowIndex = 2
wechatRowIndex = wechatRowIndex + 1
Loop
LastLine:
Debug.Print "查詢結束"
Close #1
wechatFile = Dir
queryDatawechatRowIndex = 2
Loop
End Sub
Sub clear1_Click()
Dim currentFileDirectory
currentFileDirectory = Application.ActiveWorkbook.Path
Dim queryDataRowCnt As Integer
queryDataRowCnt = Application.Sheets(1).UsedRange.Rows.Count
For rowIndex = 2 To queryDataRowCnt
Application.Sheets(1).Cells(rowIndex, 1).Value = ""
Application.Sheets(1).Cells(rowIndex, 2).Value = ""
Application.Sheets(1).Cells(rowIndex, 3).Value = ""
Next
End Sub