vbs csv 編集

質問

vbsを実行し下記のようにcsvを編集することは可能でしょうか。
ドラッグアンドロップでvbsを実行することとします。
＜実行前＞
A列　B列　　C列
名前　性別　出身地
田中　男　　北海道
佐藤　女　　沖縄
伊藤　女　　東京
桜井　男　　東京
＜実行後＞
A列　B列　　C列　　D列　　　E列
田中　男　　北海道　000001　学生
佐藤　女　　沖縄　　000002　学生
伊藤　女　　東京 100000　社会人
桜井　男　　東京　　100001　社会人

編集箇所としては、
・一行目を削除し、二行目を先頭にする。
・D列には000001~999999まで連番で値を追加
・E列には、D列の値が「~99999」の場合は、学生。
　それ以上は、社会人と記載するようにする。

宜しくお願いします。

回答No.2

watabe007 · ベストアンサー

>B列,C列のみ最後の行に出力されてしまいます。（１１,学生）
実行前CSVの最後に改行があり空白行にD、E列を追加したようです。
Option Explicit
Dim objArgs, Fso, Arg, buf, FilePath, i
Set objArgs = WScript.Arguments
Set Fso = CreateObject("Scripting.FileSystemObject")
If objArgs.Count < 1 Then WScript.Quit
For Each Arg In objArgs
FilePath = Arg
With Fso.OpenTextFile(FilePath)
.SkipLine '1行スキップ
buf = .ReadAll
.Close
End With
buf = Split(buf, vbCrLf)
For i = 0 To Ubound(buf)
If Buf(i) = "" Then
ElseIf i < 99999 Then
Buf(i) = Buf(i) & "," & String(6 - Len(i+1), "0") & i + 1 & ",学生"
Else
Buf(i) = Buf(i) & "," & String(6 - Len(i+1), "0") & i + 1 & ",社会人"
End If
Next
buf = Join(buf, vbCrLf)
With FSO.OpenTextFile(FilePath, 2)
.Write buf
.Close
End With
Next
MsgBox "終わり"

お礼

ご回答ありがとうございます。

回答No.4

Prome_Lin

もし、元データが、

田中,男,北海道,a

などというように、列が多くても対応しています（最低「名前,性別,出身」の３項目は必要です）。

田中,男,北海道,000001,学生,a

Option Explicit
Dim a, c, cv, dm, f, i, j, m, n, so, r, wa, x, y
Set so = CreateObject("Scripting.FileSystemObject")
Set wa = WScript.Arguments
For i = 0 to wa.Count - 1
If LCase(so.GetExtensionName(wa(i))) = "csv" Then
f = so.GetParentFolderName(wa(i))
Set cv = so.OpenTextFile(wa(i), 1)
Set dm = so.OpenTextFile(f & "\Dummy.csv", 2, True)
cv.SkipLine
c = 0
Do Until cv.AtEndOfStream
a = Split(cv.ReadLine, ",")
c = c + 1
r = Right("000000" & CStr(c), 6)
x = ""
For j = 0 to UBound(a)
If j = 2 Then
If c < 100000 Then
y = "学生"
Else
y = "社会人"
End If
x = x & a(j) & "," & r & "," & y & ","
Else
x = x & a(j) & ","
End If
Next
dm.WriteLine Left(x, Len(x) - 1)
Loop
cv.Close
dm.Close
Set cv = Nothing
Set dm = Nothing
n = so.GetFileName(wa(i))
so.DeleteFile wa(i)
Set m = so.GetFile(f & "\Dummy.csv")
m.Name = n
End If
Next
Set wa = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

Option Explicit

「厳密に」とか「明確に」というような意味で、このオプションを設定すると、変数は、その使用の前に、必ず、「Dim」等によって、宣言しておかなければなりません。

Set so = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしていますが、今回は特に、「csv」というテキストファイルを扱うのにも必要です。

Set wa = WScript.Arguments

ドラッグ＆ドロップされるのを待っています。

For i = 0 to wa.Count - 1

ドラッグ＆ドロップされた内容は、１つ目＝「wa(0)」、２つ目＝「wa(1)」、３つ目＝「wa(2)」、・・・というように格納されます。

この「wa(0)」などは、見た目は「配列変数」のようですが、配列変数ではありません。

「wa(0)」などは、ある意味ファイルそのものです。

「wa(0)」の内容は、「D:\Programming\Test_01.csv」などとなっていますが、いったん、ドラッグ＆ドロップして、この情報が確定すると、以後、変更することは出来ません。

したがって、ファイル名順にソートしたいような場合は、他の配列変数に格納してその配列変数をソートすることになります。

「wa(0)」などのままでは、書き換えが出来ないので、ソートできないのです。

そして、ドラッグ＆ドロップされたファイルの数は、「wa.Count」で分かります。

しかし、「wa.Count」は５つドラッグ＆ドロップしたら「5」を返しますが、実際に格納されてているのは「wa(0)」というように「0」から始まります。

そこで、「For i = 0 to wa.Count - 1」というように、「- 1」が必要なのです。

If LCase(so.GetExtensionName(wa(i))) = "csv" Then

「LCase()」は、英字を小文字にする関数です。

これで「Csv」や「CSV」も、すべて「csv」になります。

「so.GetExtensionName()」は、「Scripting.FileSystemObject」の機能を使って
（頭の「so」）、ファイルの拡張子を取得します。

すなわち、ここは「もし、拡張子がcsvなら」となります。

f = so.GetParentFolderName(wa(i))

これから処理するファイルが存在するフォルダを調べています。

この処理にも、頭に「so」が付いているように、「Scripting.FileSystemObject」の機能を使っています。

Set cv = so.OpenTextFile(wa(i), 1)

「i」番目のファイルを「読み込み専用（＝「1」）」で開いています。

Set dm = so.OpenTextFile(f & "\Dummy.csv", 2, True)

いったん、書き込み用に同じフォルダ内に「Dummy.csv」ファイルを「書き込み専用（＝「2」）」で「新規作成を許可（＝「True」）」しています。

この「Dummy.csv」ファイルは、処理終了後、削除しています。

cv.SkipLine

１行読み飛ばし。

c = 0

行カウント用変数の初期化。

Do Until cv.AtEndOfStream

ドラッグ＆ドロップしたファイルの終端まで処理。

a = Split(cv.ReadLine, ",")

１行読み込んで、区切り記号を使って、配列変数に格納しています。

今回は、「csv」ファイルということで、区切り記号は「,」です。

たとえば、読み込んだ１行が「a,b,c」の場合、「a(0) = "a"」、「a(1) = "b"」、
「a(2) = "c"」となります。

c = c + 1

１行読み込んだので、１つカウント。

r = Right("000000" & CStr(c), 6)

「000001」～「999999」のような文字列を作成して「r」に入れています。

x = ""

書き込み用変数の初期化。

For j = 0 to UBound(a)

「UBound()」は、配列変数の添え字（「()」内の数字）の最大値を返します。

上記の例でしたら、「a(2) = "c"」の「2」です。

したがって、その場合は、「For j = 0 to 2」と記述しているのと同じになります。

If j = 2 Then

「j」が「2」のとき（すなわち３番目の項目を処理しようとしているとき）、

If c < 100000 Then
y = "学生"
Else
y = "社会人"
End If

「c」の値が「100000」未満なら「y = "学生"」とし、それ以外（「100000」以上）なら、「y = "社会人"」としています。

x = x & a(j) & "," & r & "," & y & ","

田中,男,北海道,000001,学生,

というような文字列を作成しています。

Else

「j」の値が「2」以外の場合は、

x = x & a(j) & ","

普通に、読み込んだ項目を「x」に付け加えています。

Next

を、すべての項目で繰り返しています。

dm.WriteLine Left(x, Len(x) - 1)

「Dummy.txt」ファイルに書き出しています。

このとき、「x」には最後に不要な「,」があるため、それ以外の分だけ書き出しています。

すなわち、「Len(x)」で、「x」の長さが分かり、その「- 1」で、それより１文字少ない文字数を、Left（左＝頭）から、抜き出しているわけです。

Loop

を、ファイルの終端まで繰り返しています。

cv.Close
dm.Close
Set cv = Nothing
Set dm = Nothing

両ファイルを閉じています。

n = so.GetFileName(wa(i))

ドラッグ＆ドロップした方のファイル名を調べています。

so.DeleteFile wa(i)

ドラッグ＆ドロップしたファイルを削除しています。

Set m = so.GetFile(f & "\Dummy.csv")

「Dummy.csv」ファイルのファイル名を変更するために、ファイルを取得しています。

m.Name = n

ファイル名をドラッグ＆ドロップしたファイルを同じにしています。

End If
Next

を、ドラッグ＆ドロップしたファイルの数だけ繰り返しています。

Set wa = Nothing
Set so = Nothing

「Set ～」で使用した変数は、その使用後、「Nothing」で解放しておきます。

MsgBox("Finished!")

いつ終わったか分からないので、最後に「Finished!」と表示しています。

回答No.3

iruyasu

D列の連番を「000001～099999」と「100000～999999」に分ける基準が抜けています。

回答No.1

watabe007

ドラッグアンドロップで
Option Explicit
Dim objArgs, Fso, Arg, buf, FilePath, i
Set objArgs = WScript.Arguments
Set Fso = CreateObject("Scripting.FileSystemObject")
If objArgs.Count < 1 Then WScript.Quit
For Each Arg In objArgs
FilePath = Arg
With Fso.OpenTextFile(FilePath)
.SkipLine '1行スキップ
buf = .ReadAll
.Close
End With
buf = Split(buf, vbCrLf)
For i = 0 To Ubound(buf)
Buf(i) = Buf(i) & "," & String(6 - Len(i+1), "0")
If i < 99999 Then
Buf(i) = Buf(i) & i + 1 & ",学生"
Else
Buf(i) = Buf(i) & i + 1 & ",社会人"
End If
Next
buf = Join(buf, vbCrLf)
With FSO.OpenTextFile(FilePath, 2)
.Write buf
.Close
End With
Next
MsgBox "終わり"

補足

ご教示ありがとうございます。
実行後のファイルを確認したところ、
B列,C列のみ最後の行に出力されてしまいます。（１１,学生）
どこを修正すればよろしいでしょうか。