回答編集履歴

3

第三弾

2020/02/28 04:15

投稿

ttyp03
ttyp03

スコア16998

test CHANGED
@@ -105,3 +105,81 @@
105
105
 
106
106
 
107
107
  ```
108
+
109
+ 第三弾
110
+
111
+ チカチカ対策
112
+
113
+ ```VBA
114
+
115
+ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
116
+
117
+
118
+
119
+ Dim rngTarget As Range
120
+
121
+ Dim rngFind As Range
122
+
123
+ Dim Trow As Long
124
+
125
+ Dim Tnum As Long
126
+
127
+ Dim Pnum As Long
128
+
129
+ Dim mark As String
130
+
131
+ Dim items() As Variant
132
+
133
+
134
+
135
+ If Target.Count > 1 Then Exit Sub '複数セル選択禁止?
136
+
137
+ If Intersect(Target, Range("A2:L301")) Is Nothing Then Exit Sub
138
+
139
+
140
+
141
+ Tnum = Cells(Target.Row, 2).Value
142
+
143
+ Pnum = Cells(Target.Row, 12).Value
144
+
145
+
146
+
147
+ mark = IIf(Cells(Target.Row, 1).Value = "", "〇", "")
148
+
149
+
150
+
151
+ maxrow = Cells(Rows.Count, 2).End(xlUp).Row
152
+
153
+
154
+
155
+ items = Range("A2:A" & maxrow).Value
156
+
157
+
158
+
159
+ For Trow = 2 To maxrow
160
+
161
+ If Cells(Trow, 2).Value = Tnum Or Cells(Trow, 12).Value = Tnum Or _
162
+
163
+ (Pnum > 0 And (Cells(Trow, 2).Value = Pnum Or Cells(Trow, 12).Value = Pnum)) Then
164
+
165
+ items(Trow - 1, 1) = mark
166
+
167
+ Else
168
+
169
+ items(Trow - 1, 1) = ""
170
+
171
+ End If
172
+
173
+ Next
174
+
175
+
176
+
177
+ Range("A2:A" & maxrow).Value = items
178
+
179
+
180
+
181
+ End Sub
182
+
183
+
184
+
185
+ ```

2

第二弾

2020/02/28 04:15

投稿

ttyp03
ttyp03

スコア16998

test CHANGED
@@ -44,7 +44,63 @@
44
44
 
45
45
  End Sub
46
46
 
47
+ ```
47
48
 
49
+
50
+
51
+ 推測第二弾
52
+
53
+
54
+
55
+ ```VBA
56
+
57
+ Dim rngTarget As Range
58
+
59
+ Dim rngFind As Range
60
+
61
+ Dim Trow As Long
62
+
63
+ Dim Tnum As Long
64
+
65
+ Dim Pnum As Long
66
+
67
+ Dim mark As String
68
+
69
+
70
+
71
+ If Target.Count > 1 Then Exit Sub '複数セル選択禁止?
72
+
73
+ If Intersect(Target, Range("A2:L301")) Is Nothing Then Exit Sub
74
+
75
+
76
+
77
+ Tnum = Cells(Target.Row, 2).Value
78
+
79
+ Pnum = Cells(Target.Row, 12).Value
80
+
81
+
82
+
83
+ mark = IIf(Cells(Target.Row, 1).Value = "", "〇", "")
84
+
85
+
86
+
87
+ MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
88
+
89
+ For Trow = 2 To MaxRow
90
+
91
+ If Cells(Trow, 2).Value = Tnum Or Cells(Trow, 12).Value = Tnum Or _
92
+
93
+ (Pnum > 0 And (Cells(Trow, 2).Value = Pnum Or Cells(Trow, 12).Value = Pnum)) Then
94
+
95
+ Cells(Trow, 1).Value = mark
96
+
97
+ Else
98
+
99
+ Cells(Trow, 1).Value = ""
100
+
101
+ End If
102
+
103
+ Next
48
104
 
49
105
 
50
106
 

1

IIf化

2020/02/28 02:31

投稿

ttyp03
ttyp03

スコア16998

test CHANGED
@@ -28,15 +28,7 @@
28
28
 
29
29
 
30
30
 
31
- If Cells(Trow, 1).Value = "" Then
31
+ mark = IIf(Cells(Trow, 1).Value = "", "〇", "")
32
-
33
- mark = "〇"
34
-
35
- Else
36
-
37
- mark = ""
38
-
39
- End If
40
32
 
41
33
 
42
34