チェック

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 関数名 ：clrBracket '
' 内容 ：括弧を階層ごとに配色 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub clrBracket()
Const LAYER_MAX As Integer = 11 ' 許容階層数(0始まりの為12階層となる) '
Dim Clr As Variant ' 階層色 '
Dim Nowlyr As Integer ' 現在の階層 '
Dim Rng As Range ' 指定ｾﾙ '
Dim Data As String ' ｾﾙ内ﾃﾞｰﾀ '
Dim Datalen As Integer ' ｾﾙ内ﾃﾞｰﾀの文字数 '
Dim Bpstk(LAYER_MAX) As Integer ' 左括弧位置記憶ｽﾀｯｸ '
Dim Stpos As Integer ' ｾﾙ内ﾃﾞｰﾀの取得開始位置 '

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Stage 1.準備 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Clr = Array( "&H00FFFF", "&H50B000", "&HF0B000", _
"&HC07000", "&H602000", "&HA03070", _
"&H0000C0", "&H0000FF", "&H00C0FF", _
"&H97BDC4", "&H808080", "&H404040") ' 階層毎の配色設定 '
Nowlyr = -1 ' 現在の階層初期化 '
Set Rng = Range("F7") ' 指定ｾﾙ設定 '
Data = Rng.Value ' ｾﾙ内ﾃﾞｰﾀ取得 '
Datalen = Len(Data) ' ｾﾙ内ﾃﾞｰﾀの文字数取得 '
Application.ScreenUpdating = False ' 処理速度を上げる為描画更新無効 '
Rng.Font.Bold = True ' 太字に変更 '
Rng.Font.Color = vbBlack ' 文字色を黒色に変更 '

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Stage 2.括弧の階層を解析 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For Stpos = 1 To Datalen ' ｾﾙ内ﾃﾞｰﾀの文字数分ループ"
Application.StatusBar = _
Stpos & "/" & Datalen & "文字目を解析しています..." ' 進捗状況表示 '
Select Case Mid(Data, Stpos, 1) ' 1文字づつ取得し解析する '
Case "(" ' 左括弧の場合 '
If Nowlyr >= LAYER_MAX Then ' 左括弧が13階層以上続いた場合AL出力 '
MsgBox "左括弧が" & LAYER_MAX + 2 & _
"回以上続いています"
Application.StatusBar = False ' 進捗状況表示終了 '
Exit Sub
End If
Nowlyr = Nowlyr + 1 ' 現在の階層を更新 '
Bpstk(Nowlyr) = Stpos ' 左括弧位置記憶ｽﾀｯｸに現在位置をｾｯﾄ '
Rng.Characters(Stpos, 1) _
.Font.Color = Clr(Nowlyr) ' 左括弧を現在の階層色に配色 '

Case ")" ' 右括弧の場合 '
If Nowlyr <= -1 Then ' 右括弧の対となる左括弧がない場合AL出力'
MsgBox "右括弧の対がありません"
Application.StatusBar = False ' 進捗状況表示終了 '
Exit Sub
End If
Rng.Characters(Stpos, 1) _
.Font.Color = Clr(Nowlyr) ' 右括弧を現在の階層色に配色 '
Nowlyr = Nowlyr - 1 ' 現在の階層を更新 '

Case Else ' 括弧以外の場合処理なし '

End Select
DoEvents ' ﾌﾘｰｽﾞ防止の為定期的にOSに制御を戻す '
Next

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Stage 3.終了処理 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.StatusBar = False ' 進捗状況表示終了 '
End Sub