前提・実現したいこと
下記エクセルを支払方法ごとにcsvにしたいです。
ソースコード
Sub csv_export()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
Dim csvFile300 As String
Dim csvFile310 As String
Dim csvFile320 As String
Dim csvFile330 As String
csvFile300 = ActiveWorkbook.Path & "\300.csv"
csvFile310 = ActiveWorkbook.Path & "\310.csv"
csvFile320 = ActiveWorkbook.Path & "\320.csv"
csvFile330 = ActiveWorkbook.Path & "\330.csv"
Open csvFile300 For Output As #300
Open csvFile310 For Output As #310
Open csvFile320 For Output As #320
Open csvFile330 For Output As #330
Dim i As Long, j As Long
Dim targetCsvFile As Workbook
i = 2
Do While ws.Cells(i, 2).Value <> ""
j = 2 Do While ws.Cells(i, j).Value <> "" If ws.Cells(i, 4).Value = "立替経費" Then Print #300, ws.Cells(i, j).Value & ","; ElseIf ws.Cells(i, 4).Value = "コーポレートカード" Then Print #310, ws.Cells(i, j).Value & ","; ElseIf ws.Cells(i, 4).Value = "海外送金" Then Print #320, ws.Cells(i, j).Value & ","; ElseIf ws.Cells(i, 4).Value = "振替" Then Print #330, ws.Cells(i, j).Value & ","; Else Print #300, ws.Cells(i, j).Value & ","; Print #310, ws.Cells(i, j).Value & ","; Print #320, ws.Cells(i, j).Value & ","; Print #330, ws.Cells(i, j).Value & ","; End If j = j + 1 Loop If ws.Cells(i, 4).Value = "立替経費" Then Print #300, vbCr; ElseIf ws.Cells(i, 4).Value = "コーポレートカード" Then Print #310, vbCr; ElseIf ws.Cells(i, 4).Value = "海外送金" Then Print #320, vbCr; ElseIf ws.Cells(i, 4).Value = "振替" Then Print #330, vbCr; Else Print #300, vbCr; Print #310, vbCr; Print #320, vbCr; Print #330, vbCr; End If i = i + 1
Loop
Close #300
Close #310
Close #320
Close #330
MsgBox "完了しました "
End Sub
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。