大学・大学院の学部学科名を取得

電話番号、郵便番号を整える

Outlookの下書き保存

VBA：二次元配列の行列を入れ替える

ExcelファイルのテーブルデータをCSV出力

VBS：CSVファイルを振り分ける

Option Explicit
Dim filePath
Dim folderPath
Dim objFSO
Dim ary1()
Dim ary2
Dim ary3
Dim ary4
Dim aryBuf
Dim strHeader
Dim strBuf

Set objFSO = CreateObject("Scripting.FileSystemObject")
folderPath = "C:\Users\hoge\Documents\Programing\VBS\"
filePath = "C:\Users\hoge\Documents\Programing\VBS\test.csv"

With objFSO.GetFile(filePath).OpenAsTextStream
    strHeader = .ReadLine
    Redim ary1(0)
    Redim ary2(0)
    Redim ary3(0)
    Redim ary4(0)
    Do Until .AtEndofStream
        strBuf = .ReadLine
        aryBuf = Split(strBuf,",")
        Select Case aryBuf(0)
            Case 1
                ary1(Ubound(ary1)) = strBuf
                Redim Preserve ary1(Ubound(ary1)+1)
            Case 2
                ary2(Ubound(ary2)) = strBuf
                Redim Preserve ary2(Ubound(ary2)+1)
            Case 3
                ary3(Ubound(ary3)) = strBuf
                Redim Preserve ary3(Ubound(ary3)+1)
            Case 4
                ary4(Ubound(ary4)) = strBuf
                Redim Preserve ary4(Ubound(ary4)+1)
        End Select
    Loop
end With
Set objFSO = Nothing
Call outputCSV(folderPath & "1.csv",strHeader,ary1)
Call outputCSV(folderPath & "2.csv",strHeader,ary2)
Call outputCSV(folderPath & "3.csv",strHeader,ary3)
Call outputCSV(folderPath & "4.csv",strHeader,ary4)

Sub outputCSV(argPath,argHeader,argAry)
    Dim i
    Dim objFSO
    Dim objText

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objText = objFSO.OpenTextFile(argPath , 8 , True)
    With objText
        .WriteLine argHeader
        For i = 0 to Ubound(argAry) - 1
            .WriteLine argAry(i)
        Next
        .Close
    End With
    set objFSO = Nothing
End Sub

画像アップてすと