回答編集履歴

1

追記

2020/08/17 07:55

投稿

mattuwan
mattuwan

スコア2163

test CHANGED
@@ -5,3 +5,89 @@
5
5
  ↑これじゃないですかね?
6
6
 
7
7
  最新のバージョンにアップデートしたら、なおるかも?
8
+
9
+
10
+
11
+ コードの方はこんな感じでまとめてみてはいかがでしょうか。
12
+
13
+ ```ExcelVBA
14
+
15
+ Option Explicit
16
+
17
+
18
+
19
+ Private Sub Worksheet_SelectionChange(ByVal Target As Range)
20
+
21
+ Dim rngEventArea As Range: Set rngEventArea = Me.Range("C3:F10")
22
+
23
+ Dim c As Range
24
+
25
+
26
+
27
+ Set Target = Intersect(Target.Resize(, 1), rngEventArea)
28
+
29
+ If Target Is Nothing Then Exit Sub
30
+
31
+
32
+
33
+ For Each c In Target.Cells
34
+
35
+ CheckOnOff c
36
+
37
+ Next
38
+
39
+
40
+
41
+ rngEventArea(0, 1).Select
42
+
43
+ End Sub
44
+
45
+
46
+
47
+ Private Sub CheckOnOff(ByRef c As Range)
48
+
49
+ Dim cmyTrue As String: cmyTrue = ChrW(9745)
50
+
51
+ Dim cmyFalse As String: cmyFalse = ChrW(9744)
52
+
53
+ Dim cDefault As String: cDefault = ChrW(9744) & "リハ"
54
+
55
+ Dim s As String
56
+
57
+ Dim flg As Boolean
58
+
59
+
60
+
61
+ If c.Font.Color = rgbLightSlateGray Then Exit Sub
62
+
63
+ s = c.Value
64
+
65
+ flg = CBool(InStr(s, cmyFalse))
66
+
67
+ If flg Then
68
+
69
+ s = Replace(s, cmyFalse, cmyTrue)
70
+
71
+ Else
72
+
73
+ s = Replace(s, cmyTrue, cmyFalse)
74
+
75
+ End If
76
+
77
+ c.Value = s
78
+
79
+ If CBool(c.Column Mod 2) Then
80
+
81
+ With c.Offset(, 1)
82
+
83
+ .Value = cDefault
84
+
85
+ .Font.Color = IIf(flg, vbBlack, rgbLightSlateGray)
86
+
87
+ End With
88
+
89
+ End If
90
+
91
+ End Sub
92
+
93
+ ```