'############################################################# ' 文字種別カウント 3(VBScript) '  TjSoft-42, Taiju, 2007.9.30 ' 【使い方】 '  単独で使用できる。 '  選択文字を文字種別にカウントする。 '  結果を「頻度順にソート」してテキストに書き出す。 '  調べたいテキストファイルのあるフォルダに '  このスクリプトを置いてダブルクリックする。 '  「・」=Chr(-32443)がコード表で繰り返されるため、 '  現在の指定方法では「・」の数はうまく表示できない。 '############################################################# Set fs = CreateObject("Scripting.FileSystemObject") sFolderName = fs.GetAbsolutePathName(".") sTargetFileName = InputBox("TEXTファイル名を拡張子を含めて入力") sInputFileName = sFolderName & "\" & sTargetFileName Set objTextFile = fs.OpenTextFile(sInputFileName) sTargetString = objTextFile.ReadAll Set objRegExp = New RegExp For i = -32448 To 128 If i > 39 And i < 47 Then objRegExp.Pattern = Chr(92) & Chr(i) ElseIf i = 63 Then objRegExp.Pattern = Chr(92) & Chr(63) ElseIf i > 90 And i < 95 Then objRegExp.Pattern = Chr(92) & Chr(i) ElseIf i >= 9 And i <= 32 Then If i = 10 Then objRegExp.Pattern = "[LF]" 'カウントしない設定。 ElseIf i = 13 Then objRegExp.Pattern = "[CR]" 'カウントしない設定。 Else objRegExp.Pattern = Chr(92) & Chr(i) End If Else objRegExp.Pattern = Chr(i) End If With objRegExp .IgnoreCase = False .Global =True End with Set objMatches = objRegExp.Execute(sTargetString) For Each objMatch In objMatches If objMatch.Value <> sPrev Then iSumCount = objMatches.Count '総文字数も出てしまう。 If objMatch.Value = Chr(-32448) Then sPrev = "[全角スペース]" ElseIf objMatch.Value = Chr(9) Then sPrev = "[TAB]" ElseIf objMatch.Value = Chr(13) Then sPrev = "[CR]" ElseIf objMatch.Value = Chr(32) Then sPrev = "[SPACE]" Else sPrev =objMatch.Value End If sStringCount = sStringCount & iSumCount & Chr(9) & sPrev & vbCr sPrev = objMatch.Value iSumCount = 0 End If Next Next sFN = fs.GetFileName(sInputFileName) sFiLename = sFolderName & "\research~[" & sFN & "](" & Month(Date()) & "-" & Day(Date()) & ").txt" If fs.FileExists(sFiLename) Then Set objResearchFile = fs.OpenTextFile(sFiLename, 8) Else Set objResearchFile = fs.CreateTextFile(sFiLename) End If sSecondaryString = sStringCount sStringCount = "" aryString = Split(sSecondaryString, vbCr) For k = UBound(aryString) - 1 To -1 Step -1 For j = UBound(aryString) - 1 To -1 Step -1 i = j - 1 If i < 0 Then Exit For If StrComp(aryString(i), aryString(j)) = -1 Then dummyData = aryString(i) aryString(i) = aryString(j) aryString(j) = dummyData dummyData="" End If Next sConStr = Join(aryString, vbCr) Next objResearchFile.WriteLine(sConStr) sConStr = "" Erase aryString objResearchFile.Close Set objCheckFile = fs.GetFile(sInputFiLename) If objCheckFile.Size =< 2 Then fs.DeleteFile objCheckFile, True End If