导入csv文件
Private Sub Inport_Renkei_CSV_Click_Click()
Dim rowIndex As Integer, item As Integer
Dim fileName As String, currLine As String, rowDataArr() As String
fileName = Application.GetOpenFilename("連携CSVファイル(*.csv),*.csv")
VarType (fileName)
If fileName = "False" Then
Exit Sub
End If
rowIndex = 0
Open fileName For Input As #1
Do While Not EOF(1)
Line Input #1, currLine
rowDataArr = Split(currLine, Chr(44))
For item = 0 To UBound(rowDataArr)
If Left(rowDataArr(item), 1) = Chr(34) And Right(rowDataArr(item), 1) = Chr(34) Then
rowDataArr(item) = Mid(rowDataArr(item), 2, Len(rowDataArr(item)) - 2)
End If
Cells(rowIndex + 1, item + 1).NumberFormatLocal = "@"
Cells(rowIndex + 1, item + 1).FormulaR1C1 = rowDataArr(item)
Next item
rowIndex = rowIndex + 1
Loop
Close #1
MsgBox "success"
End Sub
导出csv文件
Private Sub Export_Renkei_CSV_Click_Click ()
Dim fileName As Variant, newFileName As String
Dim tatolRow As Long, tatolCol As Long
Dim row As Long, col As Long
Dim item As Long
With Sheet1.UsedRange
tatolRow = .Rows.Count
tatolCol = .Columns.Count
End With
newFileName = "csv"
fileName = Application.GetSaveAsFilename(InitialFileName:=fileName + newFileName, FileFilter:="連携CSVファイル(*.csv),*.csv")
If VarType(fileName) = vbBoolean Then
Exit Sub
End If
Dim fileSysObj, createFile As Object
Set fileSysObj = CreateObject("Scripting.FileSystemObject")
Set createFile = fileSysObj.createtextfile(fileName)
Dim XheadData As Variant
XheadData = Rows(1)
Dim headLine As String
headLine = ""
For col = 1 To tatolCol
If headLine = "" Then
headLine = Chr(34) & XheadData(1, col) & Chr(34)
Else
headLine = headLine & Chr(44) & Chr(34) & XheadData(1, col) & Chr(34)
End If
Next col
createFile.writeline (headLine)
Dim Xdata() As Variant
ReDim Preserve Xdata(tatolCol)
Dim dataLine As String
dataLine = ""
For row = 2 To tatolRow
For col = 1 To tatolCol
If col > 2 And col < 10 Then
Xdata(col) = Chr(34) & Sheet1.Cells(row, col).Value & Chr(34)
Else
Xdata(col) = Sheet1.Cells(row, col).Value
End If
Next col
For item = 1 To UBound(Xdata)
If dataLine = "" Then
dataLine = Xdata(item)
Else
dataLine = dataLine & Chr(44) & Xdata(item)
End If
Next item
createFile.writeline (dataLine)
dataLine = ""
Next row
MsgBox "CSV出力が完了しました。"
Range("a1").Select
End Sub