CSVのカラム（列）を入れ替えるVBS

とりあえず動くVBScriptを作成しました。

BBB,DDD,EEE,AAA,CCC

1, 2, 3, 4, 5

↓

AAA,BBB,CCC,DDD,EEE

4, 1, 5, 2, 3

というように列ごと入れ替えたいときに作ったスクリプトです。

フォルダ構成

CSVColReplace_D&D

├CSVColReplace_D&D.vbs

├ Input.txt

└ TargetCSV.csv

CSVColReplace_D&D.vbs と同じフォルダにある Input.txt を読み込むように作ったのでこのようなフォルダ構成である必要があります。

出力output.csvも CSVColReplace_D&D.vbs と同じフォルダに出力します。

使い方

TargetCSV.csvをCSVColReplace_D&D.vbsにドラッグアンドドロップすると、

Input.txtに書いた順番に従って、列を並び替えたoutput.csvが出力されます。

Input.txt

AAA
BBB
CCC
DDD
EEE

TargetCSV.csv

BBB,DDD,EEE,AAA,CCC
1,2,3,4,5
1,2,3,4,5
1,2,3,4,5
1,2,3,4,5
1,2,3,4,5
1,2,3,4,5
1,2,3,4,5

CSVColReplace_D&D.vbs

Option Explicit
On Error Resume Next

' ==============================
' 変数
' ==============================
Dim objParam
Dim strFileName
Dim objFileSys
Dim strParentFolder
Dim objFileInput
Dim objFileOutput
Dim objFileText
Dim aryDestCols()
Dim strLine
Dim arySrcCols
Dim strCol
Dim mapNum
Dim TextBase
Dim i
Dim j
' ==============================
' 定数
' ==============================
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' ==============================
' 処理
' ==============================
'引数チェック
set objParam = WScript.Arguments
'ファイルシステムオブジェクト
Set objFileSys = WScript.CreateObject("Scripting.FileSystemObject")

If objParam.Count = 0 Then
	strFileName = InputBox("変換したい CSV のファイルをドラッグアンドドロップしてください。")
Else
	strFileName = objParam(0)
End If

'ファイル名が入力されなかったら終了
If strFileName = "" Then
	WScript.Quit
End If

'ファイル読み込み
Set objFileInput = objFileSys.OpenTextFile(strFileName, ForReading)
strParentFolder = objFileSys.GetParentFolderName(strFileName)
Set objFileOutput = objFileSys.CreateTextFile(strParentFolder & "\output.csv", True)
Set objFileText = objFileSys.OpenTextFile(strParentFolder & "\Input.txt", ForReading)

'1行目処理
'マップ作成と入れ替え処理を行う。
ReDim mapNum(1)
mapNum(0)=0
'j=1
j=0
'CSVを1行読み込み
strLine = objFileInput.ReadLine
arySrcCols = Split(strLine,",")
'マップ作成
Do While objFileText.AtEndOfStream <> True
	TextBase = objFileText.ReadLine
	For i=0 To UBound(arySrcCols)
		If InStr(arySrcCols(i),TextBase) Then
			j=j+1
			ReDim Preserve mapNum(j)
			mapNum(j-1) = i
			Exit For
		End If
	Next
Loop

'入れ替え
ReDim aryDestCols(UBound(arySrcCols))
'aryDestCols(0) = arySrcCols(0)
For i=0 To  UBound(arySrcCols)
	aryDestCols(i) = arySrcCols(mapNum(i))
Next

objFileOutput.Write Join(aryDestCols, ",") & vbCrLf

'2行目以降処理
Do Until objFileInput.AtEndOfStream
	'CSVを1行読み込み
	strLine = objFileInput.ReadLine
	arySrcCols = Split(strLine, ",")

	'入れ替え
	'aryDestCols(0) = arySrcCols(0)
	For i=0 To  UBound(arySrcCols)
		aryDestCols(i) = arySrcCols(mapNum(i))
	Next

	objFileOutput.Write Join(aryDestCols, ",") & vbCrLf
Loop

objFileOutput.Close
objFileInput.Close
objFileText.Close