エクセルのマクロ

質問

Sub test()

x = Range("b1")
z = Len(x)
　For i = 1 To z
　　Range("a1").Offset(i - 1, 0).Value = Mid(x, i, 1)
　Next i

End Sub

上記は、"B1"に入力されているデータを、"A1"から下方向に一文字ずつ入力していくマクロです。
これに条件を付け加えたいのですが。

"今日(きょうは)雨[あめ]でした"のように、"( )"や"[ ]"内の文字はカッコも含めてフォントが赤(ColorIndex = 3)になるようにしたいのですが。
上の例だと、"(きょうは)"と"[あめ]"のフォントが赤になります。

おわかりの方がいましたら、お願いいたします。

回答No.1

noname#101556 · ベストアンサー

以下ご参考に。

Sub testred()

x = Range("b1")
z = Len(x)
For i = 1 To z
ck = Mid(x, i, 1)
If ck = "[" Or ck = "(" Then
red = True
End If
Range("a1").Offset(i - 1, 0).Value = ck
If red Then
Range("a1").Offset(i - 1, 0).Font.ColorIndex = 3
End If
If ck = "]" Or ck = ")" Then
red = False
End If
Next i

End Sub

括弧の閉じの妥当性チェックは別途考慮してください。"今日(きょうは(雨[あめ]でした"の場合、「雨」も赤くなります。

お礼

ありがとうございました。
ＯＫでした。

回答No.4

NCU

そのまんまです。

Sub 切り出し着色()
　　Dim x As String, y As String, i As Integer, j As Integer
　　x = Range("B1").Text
　　For i = 1 To Len(x)
　　　　y = Mid(x, i, 1)
　　　　If y = "(" Or y = "（" Or y = "[" Or y = "［" Then j = j + 1
　　　　With Range("A1").Offset(i - 1)
　　　　　　.Value = y
　　　　　　If j > 0 Then .Font.ColorIndex = 3
　　　　End With
　　　　If y = ")" Or y = "）" Or y = "]" Or y = "］" Then j = j - 1
　　Next
End Sub

お礼

ありがとうございました。
ＯＫでした。

回答No.3

imogasi

Sub test01()
Dim x As Range
Set x = Range("b1")
For i = 1 To Len(x)
Select Case Mid(x, i, 1)
Case "(", "["
cmode = "y"
Case Else
End Select
Cells(i, "A") = Mid(x, i, 1)
If cmode = "y" Then
Cells(i, "A").Font.ColorIndex = 3
x.Characters(i, 1).Font.ColorIndex = 3
End If
Select Case Mid(x, i, 1)
Case ")", "]"
cmode = "n"
Case Else
End Select
Cells(i, "A").Orientation = xlVertical
Cells(i, "A").HorizontalAlignment = xlLeft
Next i
End Sub
実際やってみると、時間のかかった課題でした。
縦書きセルの文字は括弧を変え、左詰めにしてます。

お礼

ありがとうございました。
ＯＫでした。

回答No.2

ja7awu

こんな感じで如何でしょうか。
所定外のフォント色は、黒とします。
文字列を変更して何回実行してもいいように対処しています。

Sub test()
Dim x As String
Dim i As Integer
Dim Flg As Boolean
Range("A:A").Clear
x = Range("b1").Value
For i = 1 To Len(x)
　　If Not Flg Then
　　　　If Mid(x, i, 1) = "(" Or Mid(x, i, 1) = "[" Then Flg = True
　　End If
　　With Range("A" & i)
　　　　.Value = Mid(x, i, 1)
　　　　If Flg Then
　　　　　　.Font.ColorIndex = 3
　　　　Else
　　　　　　.Font.ColorIndex = 0
　　　　End If
　　　　If Flg Then
　　　　　　If Mid(x, i, 1) = ")" Or Mid(x, i, 1) = "]" Then Flg = False
　　　　End If
End With
Next i
End Sub

お礼

ありがとうございました。
ＯＫでした。