テスト53

```vb

Sub CSV_Output()

Dim ws As Worksheet
Dim File_Path As String
Dim csv As String
Dim i As Long
Dim j As Long

Set ws = ThisWorkbook.Sheets("修正")
File_Path = ThisWorkbook.Path & "\test.csv"

Open File_Path For Output As #1

    i = 1
    With ws
    
        Do Until .Cells(i, 1).Value = ""
        
            j = 1
            Do Until .Cells(i, j + 1).Value = ""
                '入力
                Print #1, .Cells(i, j).Value; ",";
                j = j + 1
        
            Loop
        
            '改行
            Print #1, .Cells(i, j).Value & vbCrLf;
            i = i + 1
        
        Loop
    
    End With

Close #1

MsgBox "終了しました。"

End Sub

'----------------------------------------------------

Sub CSV_Intput()
'〃∩   ∧＿∧
'⊂⌒（ 　・ω・）＜メモです
'　 ｀ヽ_っ⌒/⌒ｃ
'　　　　 ⌒ ⌒
Dim num As Integer
Dim buf() As Byte
Dim sh As Worksheet
Dim DataList As Variant
Dim temp As Variant
Dim Data() As Variant
Dim RowNum As Long
Dim i As Long
Dim j As Long

Set sh = ThisWorkbook.Sheets("修正2")
sh.Cells.ClearContents

With sh

    Union(.Columns(2), _
          .Columns(7), _
          .Columns(12), _
          .Columns(17)).NumberFormatLocal = "@"
               
    Union(.Columns(3), _
          .Columns(8), _
          .Columns(13), _
          .Columns(18)).NumberFormatLocal = "0"
           
End With

num = FreeFile

Open ThisWorkbook.Path & "\test.csv" For Binary As #num

ReDim buf(1 To LOF(num))

Get #num, , buf

Close #num

DataList = Split(StrConv(buf, vbUnicode), vbCr)

If UBound(DataList) = 0 Then

    DataList = Split(StrConv(buf, vbUnicode), vbCrLf)
    
End If

RowNum = UBound(DataList)

For i = 1 To RowNum     '行方向の処理

    temp = Split(DataList(i - 1), ",")

    ReDim Preserve Data(1 To RowNum, 1 To UBound(temp) + 1)
    
    For j = 1 To UBound(temp) + 1   '列方向の処理

        Data(i, j) = temp(j - 1)
    
    Next j

Next i

ThisWorkbook.Sheets("修正2").Range("A1").Resize(UBound(Data), UBound(Data, 2)).Value = Data

MsgBox "処理が終了しました。"

End Sub


'指定のシートをCSVファイルとして出力、保存する
Sub SaveCSV()

Dim FPath As String
Dim FName As String
Dim FSO As Variant

Set FSO = CreateObject("Scripting.FileSystemObject")

FPath = ThisWorkbook.Path
FName = "Test" & ".csv"
 
Application.DisplayAlerts = False
 
ThisWorkbook.Sheets("CSV").Copy
ActiveWorkbook.SaveAs Filename:=FSO.BuildPath(FPath, FName), _
                      FileFormat:=xlCSV
ActiveWindow.Close
 
Application.DisplayAlerts = True
Set FSO = Nothing

End Sub

'-----------------------------------------------------------
Sub Get_CSV()
'CSV取込をマクロ記録を使った場合に生成されたコード
With ActiveSheet.QueryTables.Add( _
    Connection:="TEXT;C:\Users\User\Desktop\VBA練習\testA.csv", _
    Destination:=Range("$A$1"))
    .CommandType = 0
    .Name = "testA"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 932
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 2, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

End Sub