teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

3

第三弾

2020/02/28 04:15

投稿

ttyp03
ttyp03

スコア17002

answer CHANGED
@@ -51,4 +51,43 @@
51
51
  End If
52
52
  Next
53
53
 
54
+ ```
55
+ 第三弾
56
+ チカチカ対策
57
+ ```VBA
58
+ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
59
+
60
+ Dim rngTarget As Range
61
+ Dim rngFind As Range
62
+ Dim Trow As Long
63
+ Dim Tnum As Long
64
+ Dim Pnum As Long
65
+ Dim mark As String
66
+ Dim items() As Variant
67
+
68
+ If Target.Count > 1 Then Exit Sub '複数セル選択禁止?
69
+ If Intersect(Target, Range("A2:L301")) Is Nothing Then Exit Sub
70
+
71
+ Tnum = Cells(Target.Row, 2).Value
72
+ Pnum = Cells(Target.Row, 12).Value
73
+
74
+ mark = IIf(Cells(Target.Row, 1).Value = "", "〇", "")
75
+
76
+ maxrow = Cells(Rows.Count, 2).End(xlUp).Row
77
+
78
+ items = Range("A2:A" & maxrow).Value
79
+
80
+ For Trow = 2 To maxrow
81
+ If Cells(Trow, 2).Value = Tnum Or Cells(Trow, 12).Value = Tnum Or _
82
+ (Pnum > 0 And (Cells(Trow, 2).Value = Pnum Or Cells(Trow, 12).Value = Pnum)) Then
83
+ items(Trow - 1, 1) = mark
84
+ Else
85
+ items(Trow - 1, 1) = ""
86
+ End If
87
+ Next
88
+
89
+ Range("A2:A" & maxrow).Value = items
90
+
91
+ End Sub
92
+
54
93
  ```

2

第二弾

2020/02/28 04:15

投稿

ttyp03
ttyp03

スコア17002

answer CHANGED
@@ -21,6 +21,34 @@
21
21
  End If
22
22
 
23
23
  End Sub
24
+ ```
24
25
 
26
+ 推測第二弾
25
27
 
28
+ ```VBA
29
+ Dim rngTarget As Range
30
+ Dim rngFind As Range
31
+ Dim Trow As Long
32
+ Dim Tnum As Long
33
+ Dim Pnum As Long
34
+ Dim mark As String
35
+
36
+ If Target.Count > 1 Then Exit Sub '複数セル選択禁止?
37
+ If Intersect(Target, Range("A2:L301")) Is Nothing Then Exit Sub
38
+
39
+ Tnum = Cells(Target.Row, 2).Value
40
+ Pnum = Cells(Target.Row, 12).Value
41
+
42
+ mark = IIf(Cells(Target.Row, 1).Value = "", "〇", "")
43
+
44
+ MaxRow = Cells(Rows.Count, 2).End(xlUp).Row
45
+ For Trow = 2 To MaxRow
46
+ If Cells(Trow, 2).Value = Tnum Or Cells(Trow, 12).Value = Tnum Or _
47
+ (Pnum > 0 And (Cells(Trow, 2).Value = Pnum Or Cells(Trow, 12).Value = Pnum)) Then
48
+ Cells(Trow, 1).Value = mark
49
+ Else
50
+ Cells(Trow, 1).Value = ""
51
+ End If
52
+ Next
53
+
26
54
  ```

1

IIf化

2020/02/28 02:31

投稿

ttyp03
ttyp03

スコア17002

answer CHANGED
@@ -13,11 +13,7 @@
13
13
  Trow = Target.Row
14
14
  Prow = Cells(Trow, 12).Value
15
15
 
16
- If Cells(Trow, 1).Value = "" Then
16
+ mark = IIf(Cells(Trow, 1).Value = "", "〇", "")
17
- mark = "〇"
18
- Else
19
- mark = ""
20
- End If
21
17
 
22
18
  Cells(Trow, 1).Value = mark
23
19
  If Prow > 0 Then