1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
| Sub test3x3()
result3x3 = is3x3Unique("A1:C3")
MsgBox (result3x3)
End Sub
Function is3x3Unique(Inrange) As Boolean
Dim c1 As Boolean
Dim c2 As Boolean
Dim c3 As Boolean
Dim c4 As Boolean
Dim c5 As Boolean
Dim c6 As Boolean
Dim c7 As Boolean
Dim c8 As Boolean
If Cells(1, 1) <> Cells(1, 2) And Cells(1, 1) <> Cells(1, 3) And Cells(1, 1) <> Cells(2, 1) And Cells(1, 1) <> Cells(2, 2) And Cells(1, 1) <> Cells(2, 3) And Cells(1, 1) <> Cells(3, 1) And Cells(1, 1) <> Cells(3, 2) And Cells(1, 1) <> Cells(3, 3) _
Then c1 = True Else c1 = False
If Cells(1, 2) <> Cells(1, 3) And Cells(1, 2) <> Cells(2, 1) And Cells(1, 2) <> Cells(2, 2) And Cells(1, 2) <> Cells(2, 3) And Cells(1, 2) <> Cells(3, 1) And Cells(1, 2) <> Cells(3, 2) And Cells(1, 2) <> Cells(3, 3) _
Then c2 = True Else c2 = False
If Cells(1, 3) <> Cells(2, 1) And Cells(1, 3) <> Cells(2, 2) And Cells(1, 3) <> Cells(2, 3) And Cells(1, 3) <> Cells(3, 1) And Cells(1, 3) <> Cells(3, 2) And Cells(1, 3) <> Cells(3, 3) _
Then c3 = True Else c3 = False
If Cells(2, 1) <> Cells(2, 2) And Cells(2, 1) <> Cells(2, 3) And Cells(2, 1) <> Cells(3, 1) And Cells(2, 1) <> Cells(3, 2) And Cells(2, 1) <> Cells(3, 3) _
Then c4 = True Else c4 = False
If Cells(2, 2) <> Cells(2, 3) And Cells(2, 2) <> Cells(3, 1) And Cells(2, 2) <> Cells(3, 2) And Cells(2, 2) <> Cells(3, 3) _
Then c5 = True Else c5 = False
If Cells(2, 3) <> Cells(3, 1) And Cells(3, 1) <> Cells(3, 2) And Cells(2, 3) <> Cells(3, 3) _
Then c6 = True Else c6 = False
If Cells(3, 1) <> Cells(3, 2) And Cells(3, 1) <> Cells(3, 3) _
Then c7 = True Else: c7 = False
If Cells(3, 2) <> Cells(3, 3) _
Then c8 = True Else c8 = False
If c1 And c2 And c3 And c4 And c5 And c6 And c7 And c8 = True _
Then is3x3Unique = True
If c1 And c2 And c3 And c4 And c5 And c6 And c7 And c8 = True _
Then Exit Function Else _
MsgBox ("the highlighted 3x3 has a repeated value")
Range(Cells(1, 1), Cells(3, 3)).Select
Cells(3, 3).Activate
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
End Function |
Partager