Set fs = CreateObject("Scripting.FileSystemObject") sFolderName = fs.GetAbsolutePathName(".") sFileName = sFolderName & "\" & InputBox("ファイル名を入力") Set objTextFile = fs.OpenTextFile(sFileName) sSelectedStrings = objTextFile.ReadAll aryIndicatedStrings = Split(InputBox("数える文字を全角スペースで区切って入力","任意の文字")," ") j = UBound(aryIndicatedStrings) iTextCount = Len(sSelectedStrings) sDispText = "文字数(改行文字以外)" & ":" & Space(2) & iTextCount & vbCr Set objDic = CreateObject("Scripting.Dictionary") Set objRegExp = New RegExp objDic.Add "半角文字","[ -~。-゚]" objDic.Add "全角文字","[^ -~。-゚]" objDic.Add "空白文字(半角スペース・タブ)","\s" objDic.Add " タブ","\t" objDic.Add "空白文字以外","\S" objDic.Add "改行文字","\n" objDic.Add "全角・半角スペース","[  ]" objDic.Add " 全角スペース","[ ]" objDic.Add " 半角スペース","[ ]" objDic.Add "数字","\d" objDic.Add "アルファベット","[a-zA-Z]" objDic.Add "漢字","[亜-K]" objDic.Add "かな","[ぁ-ヶ]" objDic.Add " ひらがな","[ぁ-ん]" objDic.Add " カタカナ","[ァ-ヶ]" For i = 0 To j objDic.Add "「" & aryIndicatedStrings(i) & "」",aryIndicatedStrings(i) Next myKey = objDic.Keys myItem = objDic.Items For i = 0 To objDic.Count - 1 sKey = myKey(i) sItem = myItem(i) objRegExp.Pattern = sItem With objRegExp .IgnoreCase = True .Global = True .MultiLine = True End With iStrCount = 0 Set objMatches = objRegExp.Execute(sSelectedStrings) For Each objMatch In objMatches iStrCount = iStrCount + 1 Next sDispText = sDispText & sKey & ":" & Chr(9) & iStrCount & vbCr Next MsgBox(sDispText)