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

回答編集履歴

5

追記

2019/06/03 06:54

投稿

mattuwan
mattuwan

スコア2167

answer CHANGED
@@ -35,4 +35,6 @@
35
35
  End If
36
36
  End Sub
37
37
  ```
38
- あぁ、やってみてないけど、同じことがマクロなしでも、入力規則の機能でできるのでは?と思います。
38
+ あぁ、やってみてないけど、同じことがマクロなしでも、入力規則の機能でできるのでは?と思います。
39
+ マクロなしで出来るならマクロなしの方が、「元に戻す」がクリアされないので、
40
+ そちらの方がより良いかと思います。

4

追記

2019/06/03 06:54

投稿

mattuwan
mattuwan

スコア2167

answer CHANGED
@@ -34,4 +34,5 @@
34
34
  Application.Undo
35
35
  End If
36
36
  End Sub
37
- ```
37
+ ```
38
+ あぁ、やってみてないけど、同じことがマクロなしでも、入力規則の機能でできるのでは?と思います。

3

コードの追記

2019/06/03 06:51

投稿

mattuwan
mattuwan

スコア2167

answer CHANGED
@@ -16,4 +16,22 @@
16
16
  ```
17
17
 
18
18
  参考>>
19
- [条件付き書式で変更された書式を取得する](https://excel-ubara.com/excelvba5/EXCELVBA263.html)
19
+ [条件付き書式で変更された書式を取得する](https://excel-ubara.com/excelvba5/EXCELVBA263.html)
20
+
21
+ 追記>>
22
+ セルに入力した時にチェックするなら、色がどうのとか関係ないですよね?
23
+ ```ExcelVBA
24
+ Private Sub Worksheet_Change(ByVal Target As Range)
25
+ Dim rngEventArea As Range: Set rngEventArea = Me.Range("B4:D8")
26
+
27
+ If Target.CountLarge > 1 Then Exit Sub
28
+ Set Target = Intersect(Target, rngEventArea)
29
+ If Target Is Nothing Then Exit Sub
30
+ Set rngEventArea = Intersect(Target.EntireRow, rngEventArea)
31
+
32
+ If WorksheetFunction.CountIf(rngEventArea.Cells, Target.Value) > 1 Then
33
+ MsgBox "既に同じ値を入力済みです。", vbExclamation
34
+ Application.Undo
35
+ End If
36
+ End Sub
37
+ ```

2

修正

2019/06/03 06:48

投稿

mattuwan
mattuwan

スコア2167

answer CHANGED
@@ -6,7 +6,7 @@
6
6
  Sub test()
7
7
  Dim c As Range
8
8
 
9
- For Each c In Range("B5:D8")
9
+ For Each c In Range("B4:D8")
10
10
  If c.DisplayFormat.Interior.Color = vbRed Then
11
11
  MsgBox "重複があります。: " & c.Address(False, False)
12
12
  Exit Sub

1

修正

2019/06/02 08:32

投稿

mattuwan
mattuwan

スコア2167

answer CHANGED
@@ -6,7 +6,7 @@
6
6
  Sub test()
7
7
  Dim c As Range
8
8
 
9
- For Each c In Range("B5:E8")
9
+ For Each c In Range("B5:D8")
10
10
  If c.DisplayFormat.Interior.Color = vbRed Then
11
11
  MsgBox "重複があります。: " & c.Address(False, False)
12
12
  Exit Sub