集計用スクリプト完成!【無職だめ板出張所】

集計用スクリプトが完成しました！

まずは使い方を説明。

1)　どこか適当なところに　集計用スクリプト　というフォルダを作成します。
2)　集計用スクリプトフォルダには、 星.txt と 前回.txt と a.txt と 1.vbs が
　　なければなりません。
3)　集計用スクリプトフォルダのショートカットをデスクトップに作ると
　　よいでしょう。

総統 Й∇Й
元帥 ∬Ж∬
大将 IIIΨIII
中将 IIΨII
少将 IΨI
准将 _Ψ_
大佐 III§III
中佐 II§II
少佐 I§I
大尉 III☆III
中尉 II☆II
少尉 I☆I
曹長 φ
軍曹 φ
伍長 φ
新兵 φ

4)　>>3 をコピーして星.txtに貼り、上書き保存します。
　　星.txt内部に空行（カラの行）が存在してはいけません。
　　実行時にエラーとなります。ファイル末尾の空行には、
　　特に注意して下さい。

5)　星.txtは毎回作成する必要はありません。集計用スクリプトフォルダ
　　に置かれている星.txtファイルを読み込んで計算します。
　　階級マークが変わった時には、星.txtファイルを開いて階級マークを
　　書き換えて下さい。

今日も雑炊 ( 1763.1 , 239.5 , 65 ) 18.0 hUP 大将 IIIΨIII ∵◆ ３年間失業しない。借金返済。負債がゼロになったらCCIEに挑戦。
脳みそ ( 0.0 , 0.0 , 0 ) 0.0 hUP 新兵 φ ∵◆ 未定
にんにく ( 111.5 , 41.0 , 7 ) 4.5 hUP 伍長 φ ∵◆ 1999年度の英語教材制覇！
坂本 ( 1490.0 , 147.0 , 30 ) 10.0 hUP 少将 IΨI ∵◆ 大学受験
仕事ほしい ( 452.0 , 113.5 , 50 ) 22.0 hUP 中尉 II☆II ∵◆ 日商簿記1級・全経簿記上級をとり就職する。
有明 ( 174.2 , 39.7 , 15 ) 6.0 hUP 軍曹 φ ∵◆ 高校受験合格する！
ルーゼル ( 253.0 , 51.5 , 25 ) 8.5 hUP 曹長 φ ∵◆ 目標はとりあえず日商簿記３級！
るぐれ ( 127.0 , 34.0 , 11 ) 0.0 hUP 伍長 φ ∵◆ 未定
瓦乞食 ( 193.5 , 113.0 , 23 ) 10.0 hUP 軍曹 φ ∵◆ 未定
R-type�� ( 35.5 , 14.5 , 15 ) 6.0 hUP 新兵 φ ∵◆ 未定
じょーじょー ( 60.5 , 26.0 , 3 ) 0.0 hUP 伍長 φ ∵◆ 未定
ちょっと一服 ( 50.0 , 16.5 , 13 ) 8.0 hUP 伍長 φ ∵◆ 未定
茶(≡ω≡．)犬 ( 3.3 , 3.3 , 3 ) 0.0 hUP 新兵 φ ∵◆ 小学校教員になるぅ。
及介 ( 0.0 , 0.0 , 0 ) 0.0 hUP 新兵 φ ∵◆ 日商簿記検定1級。
ポルチオ ( 5.5 , 5.5 , 6 ) 0.0 hUP 新兵 φ ∵◆ 未定

6)　前回.txt には、前回の集計結果を貼ります。このファイルを
　　読み込んで計算に使用します。茶犬さんが最近始めた週間目標には、
　　現在のところ対応しておりません。読み込み時にエラーとならないよう、
　　前回.txt には前回の集計時にスクリプトから出力されたファイルの
　　名前を前回.txtに変更して使うといいでしょう。

7)　茶犬さんが最近始めた週間目標は、出力されたファイルをコピーして
　　手計算して書き込んで下さい。

8)　>>6 は、本日現在における最新の集計結果です。

9)　a.txt には、本スレから集計したい範囲の書き込みをコピーして
　　貼り付けて保存して下さい。スクリプトは、a.txt ファイルを
　　自動整形し、●から始まる行を抽出し、計算に使用します。

10) 目標（例：３年間失業しない。借金返済。〜）が変わったら、
　　前回.txt にて編集して下さい。次回の計算時から反映されます。

Option Explicit
Dim objWshShell, objWshShell2, objWshShell3
Dim objFS, objFS2, objFS3, objTS, objTS2, objTS3
Dim objFile, objFile2, objFile3, objRegExp
Dim objDic, objDic2, objDic3, objDic4, objDic5, objDic6, objDic7
Dim objDic8, objDic9, objDic10, objDic11, objDic12, objDic13
Dim objDic14, objDic21, objDic22, objDicStars
Dim colMatch
Dim strLine, strLine2, strLine3, strTemp, strName, strData
Dim strRank, strMark, strOldRank, strOldMark
Dim i, m, n
Dim Array1, ArrayKeys, ArrayItems, Array20, ArrayStars
Dim ArrayOutput0, ArrayOutput1, ArrayOutput2, ArrayOutput3, ArrayOutput4
Dim ArrayOutput5, ArrayOutput6, ArrayOutput7, ArrayOutput8, ArrayOutput9
Dim ArrayOutput12, ArrayOutput13
Dim ArrayOutput21, ArrayOutput22
Dim ArrayRanksList, ArrayStarsList, ArrayKeysList, ArrayItemsList3
Dim ArrayKeysList11, ArrayKeysList12, ArrayItemsList11, ArrayItemsList12
Dim ResetKey
Dim Wsum, Msum, Mmax, Ruikei

CreateTextFiles
ResetKey = 0
ResetKey = MsgBox("月末には、月内の集計を完了させて下さい。" & _
vbcr & "翌月初回の計算では、月間合計を初期化して下さい。" & _
vbcr & "月間合計を0に初期化する場合は、はいボタンをクリックして" & _
"下さい。" & vbcr & "月間合計を初期化しない場合は、いいえボタンを" & _
"クリックして下さい。", vbYesNo, "質問")
CreateArrays
Output

Sub CreateTextFiles

CreateB
CreateC
CreateD
CreateE
CreateF

End Sub

Sub CreateB
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("a.txt")
Set objTS2 = objFS.CreateTextFile("b.txt")
objTS2.Close


Set objRegExp = New RegExp
'objRegExp.Pattern = "^[0-9].*ID\:.*$|^●.*$"
objRegExp.Pattern = "^●.*$"
objRegExp.Global = True

Do Until objTS.AtEndOfStream

strLine = objTS.ReadLine
Set colMatch = objRegExp.Execute(strLine)

For Each m in colMatch

Set objFile = objFS.GetFile("b.txt")
Set objTS2 = objFS.OpenTextFile("b.txt",8,true)
objTS2.WriteLine m.Value
objTS2.Close
Next
Loop

objTS.Close
End Sub

Sub CreateC

Dim strRepStr, strNewLine

Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("b.txt")
Set objTS2 = objFS.CreateTextFile("c.txt")
objTS2.Close


Set objRegExp = New RegExp
objRegExp.Pattern = "、"
objRegExp.Global = True

strRepStr = ","

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine
strNewLine = objRegExp.Replace(strLine,strRepStr)

Set objFile = objFS.GetFile("c.txt")
Set objTS2 = objFS.OpenTextFile("c.txt",8,true)
objTS2.WriteLine(strNewLine)
objTS2.Close
Loop

objTS.Close
End Sub

Sub CreateD

Dim strRepStr, strNewLine

Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("c.txt")
Set objTS2 = objFS.CreateTextFile("d.txt")
objTS2.Close


Set objRegExp = New RegExp
objRegExp.Pattern = " "
objRegExp.Global = True

strRepStr = ""

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine
strNewLine = objRegExp.Replace(strLine,strRepStr)

Set objFile = objFS.GetFile("d.txt")
Set objTS2 = objFS.OpenTextFile("d.txt",8,true)
objTS2.WriteLine(strNewLine)
objTS2.Close
Loop

objTS.Close
End Sub

Sub CreateE

Dim strRepStr, strNewLine

Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("d.txt")
Set objTS2 = objFS.CreateTextFile("e.txt")
objTS2.Close


Set objRegExp = New RegExp
objRegExp.Pattern = "●"
objRegExp.Global = True

strRepStr = ""

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine
strNewLine = objRegExp.Replace(strLine,strRepStr)

Set objFile = objFS.GetFile("e.txt")
Set objTS2 = objFS.OpenTextFile("e.txt",8,true)
objTS2.WriteLine(strNewLine)
objTS2.Close
Loop

objTS.Close
End Sub

Sub CreateF
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("e.txt")
Set objTS2 = objFS.CreateTextFile("f.txt")
objTS2.Close

Set objRegExp = New RegExp
objRegExp.Pattern = "^.*,.*$"
objRegExp.Global = True

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine
Set colMatch = objRegExp.Execute(strLine)
For Each m in colMatch
Set objFile = objFS.GetFile("f.txt")
Set objTS2 = objFS.OpenTextFile("f.txt",8,true)
objTS2.WriteLine m.Value
objTS2.Close
Next
Loop

objTS.Close
End Sub

Sub CreateArrays

Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("前回.txt")
Set objTS2 = objFS.OpenTextFile("f.txt")
Set objDic = CreateObject("Scripting.Dictionary")
Set objDic2 = CreateObject("Scripting.Dictionary")
Set objDic3 = CreateObject("Scripting.Dictionary")
Set objDic4 = CreateObject("Scripting.Dictionary")
Set objDic5 = CreateObject("Scripting.Dictionary")
Set objDic6 = CreateObject("Scripting.Dictionary")
Set objDic7 = CreateObject("Scripting.Dictionary")
Set objDic8 = CreateObject("Scripting.Dictionary")
Set objDic9 = CreateObject("Scripting.Dictionary")
Set objDic10 = CreateObject("Scripting.Dictionary")
Set objDic11 = CreateObject("Scripting.Dictionary")
Set objDic12 = CreateObject("Scripting.Dictionary")
Set objDic13 = CreateObject("Scripting.Dictionary")
Set objDic14 = CreateObject("Scripting.Dictionary")

CreateMultiDic

End Sub

Sub CreateMultiDic

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine
Array1 = Split(strLine)
objDic.Add Array1(0),Array1(0)
objDic2.Add Array1(0),Array1(1)
objDic3.Add Array1(0),Array1(2)
objDic4.Add Array1(0),Array1(3)
objDic5.Add Array1(0),Array1(4)
objDic6.Add Array1(0),Array1(5)
objDic7.Add Array1(0),Array1(6)
objDic8.Add Array1(0),Array1(7)
objDic9.Add Array1(0),Array1(8)
objDic10.Add Array1(0),Array1(9)
objDic11.Add Array1(0),Array1(10)
objDic12.Add Array1(0),Array1(11)
objDic13.Add Array1(0),Array1(12)
objDic14.Add Array1(0),Array1(13)
Loop
objTS.Close

MonthsOutset
CreateArray20

End Sub

Sub MonthsOutset

If ResetKey = 6 Then
ArrayKeys = objDic7.Keys
For i = 0 To objDic7.Count - 1
objDic7.Item(ArrayKeys(i)) = "0"
Next
End If

End Sub

Sub CreateArray20

Do Until objTS2.AtEndOfStream
'f.txtを1行読み込む
strLine2 = objTS2.ReadLine
Array20 = Split(strLine2,",")
strName = Array20(0)
strData = Array20(1)
Wsum = Array1(0)
If objDic.Exists(strName) Then
m = FormatNumber(objDic9.Item(strName))
n = FormatNumber(strData)
Wsum = CStr(CSng(m) + CSng(n))
objDic9.Item(strName) = Wsum

m = FormatNumber(objDic7.Item(strName))
n = FormatNumber(strData)
Msum = CStr(CSng(m) + CSng(n))
objDic7.Item(strName) = Msum

m = FormatNumber(objDic5.Item(strName))
n = FormatNumber(strData)
Mmax = CStr(CSng(m) + CSng(n))
objDic5.Item(strName) = Mmax

m = FormatNumber(objDic3.Item(strName))
n = FormatNumber(strData)
Ruikei = CStr(CSng(m) + CSng(n))
objDic3.Item(strName) = Ruikei

Else
'MsgBox "新規" & strName & strData
objDic14.Add strName,"未定"
objDic13.Add strName,"∵◆"
objDic12.Add strName,"-"
objDic11.Add strName,"新兵"
objDic10.Add strName,"hUP"
objDic9.Add strName,strData
objDic8.Add strName,")"
objDic7.Add strName,strData
objDic6.Add strName,","
objDic5.Add strName,strData
objDic4.Add strName,","
objDic3.Add strName,strData
objDic2.Add strName,"("
objDic.Add strName,strName
End If
Loop
objTS2.Close
RankMark

End Sub

Sub RankMark

Const UpTo_Soutou = 2500
Const UpTo_Gensui = 2000
Const UpTo_Taisyou = 1750
Const UpTo_tyuujyou = 1500
Const UpTo_Syousyou = 1250
Const UpTo_Jyunsyou = 1000
Const UpTo_Taisa = 950
Const UpTo_tyuusa = 800
Const UpTo_Syousa = 650
Const UpTo_Taii = 500
Const UpTo_Tyuui = 400
Const UpTo_Syoui = 300
Const UpTo_Soutyou = 200
Const UpTo_Gunsou = 150
Const UpTo_Gotyou = 100

Set objDicStars = CreateObject("Scripting.Dictionary")
Set objDic21 = CreateObject("Scripting.Dictionary")
Set objDic22 = CreateObject("Scripting.Dictionary")
Set objFS3 = WScript.CreateObject("Scripting.FileSystemObject")
Set objFile3 = objFS3.GetFile("星.txt")
Set objTS3 = objFS3.OpenTextFile("星.txt")

Do Until objTS3.AtEndOfStream
strLine3 = objTS3.ReadLine
ArrayStars = Split(strLine3)
strRank = ArrayStars(0)
strMark = ArrayStars(1)
objDicStars.Add strRank,strMark
Loop
objTS3.Close

ArrayRanksList = objDicStars.Keys
ArrayStarsList = objDicStars.Items
ArrayKeysList = objDic.Keys
ArrayItemsList3 = objDic3.Items
ArrayKeysList11 = objDic11.Keys
ArrayKeysList12 = objDic12.Keys
ArrayItemsList11 = objDic11.Items
ArrayItemsList12 = objDic12.Items

For i = 0 To objDic.Count - 1

If CSng(ArrayItemsList3(i)) >= UpTo_Soutou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(0)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(0)
If StrComp(ArrayItemsList11(i),ArrayRanksList(0)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(0) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Gensui Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(1)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(1)
If StrComp(ArrayItemsList11(i),ArrayRanksList(1)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(1) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Taisyou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(2)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(2)
If StrComp(ArrayItemsList11(i),ArrayRanksList(2)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(2) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_tyuujyou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(3)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(3)
If StrComp(ArrayItemsList11(i),ArrayRanksList(3)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(3) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Syousyou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(4)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(4)
If StrComp(ArrayItemsList11(i),ArrayRanksList(4)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(4) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Jyunsyou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(5)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(5)
If StrComp(ArrayItemsList11(i),ArrayRanksList(5)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(5) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Taisa Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(6)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(6)
If StrComp(ArrayItemsList11(i),ArrayRanksList(6)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(6) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_tyuusa Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(7)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(7)
If StrComp(ArrayItemsList11(i),ArrayRanksList(7)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(7) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Syousa Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(8)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(8)
If StrComp(ArrayItemsList11(i),ArrayRanksList(8)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(8) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Taii Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(9)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(9)
If StrComp(ArrayItemsList11(i),ArrayRanksList(9)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(9) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Tyuui Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(10)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(10)
If StrComp(ArrayItemsList11(i),ArrayRanksList(10)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(10) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Syoui Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(11)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(11)
If StrComp(ArrayItemsList11(i),ArrayRanksList(11)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(11) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Soutyou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(12)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(12)
If StrComp(ArrayItemsList11(i),ArrayRanksList(12)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(12) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Gunsou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(13)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(13)
If StrComp(ArrayItemsList11(i),ArrayRanksList(13)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(13) & "に昇進しました！"
End If

ElseIf CSng(ArrayItemsList3(i)) >= UpTo_Gotyou Then

objDic21.Add ArrayKeysList11(i),ArrayRanksList(14)
objDic22.Add ArrayKeysList12(i),ArrayStarsList(14)
If StrComp(ArrayItemsList11(i),ArrayRanksList(14)) <> 0 Then
MsgBox ArrayKeysList11(i) & "が" & _
ArrayRanksList(14) & "に昇進しました！"
End If

Else

objDic21.Add ArrayKeysList11(i),ArrayItemsList11(i)
objDic22.Add ArrayKeysList12(i),ArrayItemsList12(i)

End If

Next

End Sub

Sub Output

Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.CreateTextFile("Result.txt")
objTS.Close

ArrayOutput0 = objDic.Items
ArrayOutput1 = objDic2.Items
ArrayOutput2 = objDic3.Items
ArrayOutput3 = objDic4.Items
ArrayOutput4 = objDic5.Items
ArrayOutput5 = objDic6.Items
ArrayOutput6 = objDic7.Items
ArrayOutput7 = objDic8.Items
ArrayOutput8 = objDic9.Items
ArrayOutput9 = objDic10.Items
ArrayOutput21 = objDic21.Items
ArrayOutput22 = objDic22.Items
ArrayOutput12 = objDic13.Items
ArrayOutput13 = objDic14.Items

For i = 0 To objDic.Count - 1

strLine = ArrayOutput0(i) & " " & ArrayOutput1(i) & " " & _
ArrayOutput2(i) & " " & ArrayOutput3(i) & " " & _
ArrayOutput4(i) & " " & ArrayOutput5(i) & " " & _
ArrayOutput6(i) & " " & ArrayOutput7(i) & " " & _
ArrayOutput8(i) & " " & ArrayOutput9(i) & " " & _
ArrayOutput21(i) & " " & ArrayOutput22(i) & " " & _
ArrayOutput12(i) & " " & ArrayOutput13(i) & vbcr

Set objFile = objFS.GetFile("Result.txt")
Set objTS = objFS.OpenTextFile("Result.txt",8,true)
objTS.WriteLine strLine
objTS.Close

Next

Set objFile = objFS.GetFile("Result.txt")
strTemp = "集計結果(年月日時" & Minute(Time()) & "分" & Second(Time()) & "秒).txt"
objFile.Name = strTemp

Set objFile = objFS.GetFile("b.txt")
objFile.Delete True
Set objFile = objFS.GetFile("c.txt")
objFile.Delete True
Set objFile = objFS.GetFile("d.txt")
objFile.Delete True
Set objFile = objFS.GetFile("e.txt")
objFile.Delete True
Set objFile = objFS.GetFile("f.txt")
objFile.Delete True

End Sub

11)　集計用スクリプトフォルダ内に 1.txt を作成し、1.txt を開き、
　　>>10-32 の書き込みをコピーして貼り付けます。1行も欠けないように
　　注意して下さい。貼り付けが終わったら上書き保存してファイルを閉じ、
　　1.txt のファイル名を 1.vbs に変更します。

12）　ここまでの作業が終了したら、全てのファイルを閉じ、お茶を飲みます。

13）　1.vbs をダブルクリックすると、集計結果(年月日時X分X秒).txtという
　　　ファイルが集計用スクリプトフォルダ内に生成されます。このファイルに
　　　集計結果が書き出されています。

14)　集計用スクリプトフォルダ内にフォルダを作成して構いません。適当な
　　フォルダを作成し、過去の集計結果を保存しておくとよいでしょう。

15）　出力されるファイルが集計結果(年月日時X分X秒).txtという変な
　　　名前であるのには理由があります。集計用スクリプトフォルダ内に
　　　同じ名前の計算結果出力ファイルが存在すると、上書きせずに
　　　エラーとなります。集計用スクリプトフォルダのサブディレクトリに
　　　同じ名前のファイルがあっても問題ありません。

終わった〜。長かった〜。

これで責任を果たせた〜。

雑炊さんお疲れ様です。すごく長いソースだ。

手前味噌になるけど、作成者の独り言ね。


このスクリプトの優れている点：

　VBSとテキストファイルしか使っていないので、エクセルを持って
　いない人でも集計を代行できる。WindowsだけあればOKです。

　シンプルで読みやすいコード。天使のコード。収束部分の美しさは、
　作者（おいどん）の構想力がハンパじゃないことを物語る。全体を
　貫く棒のごときものが見える。

　八極拳か？小野派一刀流か？日本拳法か？丈和か？
　素人とは思えない力強いスタイル！(｀･ω･´)ｴﾍﾝ！

>>35

おお！まりがとん！

One Liner （一行野郎）という言葉があるように、専門家には
短いコードを良しとする人もいる。その言語に精通していれば、
短く書けますからね。

でも、おいどんは職業プログラマーじゃないから、1行で1つのことしか
やりたくないし、できない。

(｀･ω･´)ｴﾍﾝ！

>>37
これで集計が楽になりますね。ほんとにお疲れ様です。
動作確認してみたらばっちり動きました。

>>38

>動作確認してみたらばっちり動きました。

デバッグしながら作ったからね！(｀･ω･´)ｴﾍﾝ！

昇進時間の基準が変わった時に容易に対応できる作りに
なっています。

雑炊さん、お疲れ様でした。
僕の負担も軽くなりますよ。
ありがとう。

>>41

茶犬さんには長い間無理させてしまって申し訳ないです。

時間のある俺がこういうの作らないでどうするんだ・・・。

3ヶ所不具合修正しました。スクリプトファイル 1.txtの
上書きをお願いします。

Sub CreateE

Dim strRepStr, strNewLine
Dim strKey0, strKey1, strKey2, strKey3, strKey4
Dim strKey5, strKey6, strKey7, strKey8, strKey9
Dim strKey10
Dim strNew0, strNew1, strNew2, strNew3, strNew4
Dim strNew5, strNew6, strNew7, strNew8, strNew9
Dim strNew10

strKey0 = "０"
strKey1 = "１"
strKey2 = "２"
strKey3 = "３"
strKey4 = "４"
strKey5 = "５"
strKey6 = "６"
strKey7 = "７"
strKey8 = "８"
strKey9 = "９"
strKey9 = "，"

strNew0 = "0"
strNew1 = "1"
strNew2 = "2"
strNew3 = "3"
strNew4 = "4"
strNew5 = "5"
strNew6 = "6"
strNew7 = "7"
strNew8 = "8"
strNew9 = "9"
strNew10 = ","

Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("d.txt")
Set objTS2 = objFS.CreateTextFile("e.txt")
objTS2.Close

Set objRegExp = New RegExp
objRegExp.Global = True

Do Until objTS.AtEndOfStream
objRegExp.Pattern = "●"
strRepStr = ""
strLine = objTS.ReadLine
strNewLine = objRegExp.Replace(strLine,strRepStr)
strNewLine = replace(strNewLine,strKey0,strNew0)
strNewLine = replace(strNewLine,strKey1,strNew1)
strNewLine = replace(strNewLine,strKey2,strNew2)
strNewLine = replace(strNewLine,strKey3,strNew3)
strNewLine = replace(strNewLine,strKey4,strNew4)
strNewLine = replace(strNewLine,strKey5,strNew5)
strNewLine = replace(strNewLine,strKey6,strNew6)
strNewLine = replace(strNewLine,strKey7,strNew7)
strNewLine = replace(strNewLine,strKey8,strNew8)
strNewLine = replace(strNewLine,strKey9,strNew9)
strNewLine = replace(strNewLine,strKey10,strNew10)

objRegExp.Pattern = " $"
strRepStr = ""
strNewLine = objRegExp.Replace(strNewLine,strRepStr)
objRegExp.Pattern = "　$"
strRepStr = ""
strNewLine = objRegExp.Replace(strNewLine,strRepStr)
objRegExp.Pattern = ",　"
strRepStr = ","
strNewLine = objRegExp.Replace(strNewLine,strRepStr)
objRegExp.Pattern = ", "
strRepStr = ","
strNewLine = objRegExp.Replace(strNewLine,strRepStr)
Set objFile = objFS.GetFile("e.txt")
Set objTS2 = objFS.OpenTextFile("e.txt",8,true)
objTS2.WriteLine(strNewLine)
objTS2.Close
Loop

objTS.Close
End Sub

お願い　その1

以下の部分を丸ごと差し替えて下さい。（Sub CreateFの1行上まで）
↓　
↓　ここから
--------------------------

Sub CreateE

　ほにゃらら
　ほにゃらら
　ほにゃらら

End Sub

--------------------------
↑　ここまで

>>49　の差し替えには、>>45-48 を使って下さい。
（1行も欠けないようにご注意願います。）

申告の書式に微妙に違反しても極力受け入れるように改造しました。

Sub CreateF
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFS = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.OpenTextFile("e.txt")
Set objTS2 = objFS.CreateTextFile("f.txt")
objTS2.Close

Set objRegExp = New RegExp
objRegExp.Pattern = "^.*,[0-9]+\.?[0-9]*$"
objRegExp.Global = True

Do Until objTS.AtEndOfStream
strLine = objTS.ReadLine
Set colMatch = objRegExp.Execute(strLine)
For Each m in colMatch
Set objFile = objFS.GetFile("f.txt")
Set objTS2 = objFS.OpenTextFile("f.txt",8,true)
objTS2.WriteLine m.Value
objTS2.Close
Next
Loop

objTS.Close
End Sub

お願い　その2

以下の部分を丸ごと差し替えて下さい。（Sub CreateArraysの上まで）
↓　
↓　ここから
--------------------------

Sub CreateF

　ほにゃらら
　ほにゃらら
　ほにゃらら

End Sub

--------------------------
↑　ここまで

>>52　の差し替えには、>>51 を使って下さい。
（1行も欠けないようにご注意願います。）

正規表現の誤りが原因で大量に捨ててしまっていた部分を
修正しました。

Sub CreateArray20

For Each i In objDic9
objDic9.Item(i) = 0
Next

Do Until objTS2.AtEndOfStream
'f.txtを1行読み込む
strLine2 = objTS2.ReadLine
Array20 = Split(strLine2,",")
strName = Array20(0)
strData = Array20(1)
Wsum = Array1(0)
If objDic.Exists(strName) Then
m = FormatNumber(objDic9.Item(strName))
n = FormatNumber(strData)
Wsum = CStr(CSng(m) + CSng(n))
objDic9.Item(strName) = Wsum

m = FormatNumber(objDic7.Item(strName))
n = FormatNumber(strData)
Msum = CStr(CSng(m) + CSng(n))
objDic7.Item(strName) = Msum

m = FormatNumber(objDic5.Item(strName))
n = FormatNumber(strData)
Mmax = CStr(CSng(m) + CSng(n))
objDic5.Item(strName) = Mmax

m = FormatNumber(objDic3.Item(strName))
n = FormatNumber(strData)
Ruikei = CStr(CSng(m) + CSng(n))
objDic3.Item(strName) = Ruikei
Else

'MsgBox "新規" & strName & strData
objDic14.Add strName,"未定"
objDic13.Add strName,"∵◆"
objDic12.Add strName,"φ"
objDic11.Add strName,"新兵"
objDic10.Add strName,"hUP"
objDic9.Add strName,"0"
objDic8.Add strName,")"
objDic7.Add strName,strData
objDic6.Add strName,","
objDic5.Add strName,strData
objDic4.Add strName,","
objDic3.Add strName,strData
objDic2.Add strName,"("
objDic.Add strName,strName
End If
Loop
objTS2.Close
RankMark

End Sub

お願い　その3

以下の部分を丸ごと差し替えて下さい。（Sub RankMarkの上まで）
↓　
↓　ここから
--------------------------

Sub CreateArray20

　ほにゃらら
　ほにゃらら
　ほにゃらら

End Sub

--------------------------
↑　ここまで

>>57　の差し替えには、>>54-56 を使って下さい。
（1行も欠けないようにご注意願います。）

前回.txt の　hup時間を繰り越していた部分を修正しました。
あと、新規参加者のφの書き込み方法を修正しました。

茶犬さん、以上の変更をよろしくお願いします。

>>59
失敗した。
明日やります。

バグがあったら言ってね。

ふむー。出力されたファイルには無駄な空行はないけど、掲示板に
貼ると無駄な空行が発生するね。ここはGWに修正しよう。

使い方は、1から順番に読んで下さい。