johnny78
Messages postés1Date d'inscriptionmercredi 23 février 2011StatutMembreDernière intervention23 février 2011
-
23 févr. 2011 à 17:55
AlKatou
Messages postés95Date d'inscriptionvendredi 7 février 2003StatutMembreDernière intervention28 novembre 2017
-
24 févr. 2011 à 18:01
hello toutlemonde
bienvenue dans le monde des noobs du VBA !
voila mon soucis: je pensais qu'en utilisant une fonction je pouvais reutiliser le meme morceau de code sans avoir a repeter les cells en question des centaines de fois mais c pas le cas les cells dans mes fonctions corresspondent tousjous a des cells en partant de A1 quimporte l'input au fonction
merci de votre temps
John
Function isRowUnique(Inrange) As Boolean
Dim ones As Boolean
Dim twos As Boolean
Dim threes As Boolean
Dim fours As Boolean
Dim fives As Boolean
Dim sixes As Boolean
Dim sevens As Boolean
Dim eights As Boolean
Dim i As Integer
For i = 1 To 9
If Cells(i, 1) <> Cells(i, 2) And Cells(i, 1) <> Cells(i, 3) And Cells(i, 1) <> Cells(i, 4) And Cells(i, 1) <> Cells(i, 5) And Cells(i, 1) <> Cells(i, 6) And Cells(i, 1) <> Cells(i, 7) And Cells(i, 1) <> Cells(i, 8) And Cells(i, 1) <> Cells(i, 9) _
Then ones True Else ones False
If Cells(i, 2) <> Cells(i, 3) And Cells(i, 3) <> Cells(i, 4) And Cells(i, 2) <> Cells(i, 5) And Cells(i, 2) <> Cells(i, 6) And Cells(i, 2) <> Cells(i, 7) And Cells(i, 2) <> Cells(i, 8) And Cells(i, 2) <> Cells(i, 9) _
Then twos True Else twos False
If Cells(i, 3) <> Cells(i, 4) And Cells(i, 1) <> Cells(i, 5) And Cells(i, 3) <> Cells(i, 6) And Cells(i, 3) <> Cells(i, 7) And Cells(i, 3) <> Cells(i, 8) And Cells(i, 3) <> Cells(i, 9) _
Then threes True Else threes False
If Cells(i, 4) <> Cells(i, 5) And Cells(i, 4) <> Cells(i, 6) And Cells(i, 4) <> Cells(i, 7) And Cells(i, 4) <> Cells(i, 8) And Cells(i, 4) <> Cells(i, 9) _
Then fours True Else fours False
If Cells(i, 5) <> Cells(i, 6) And Cells(i, 5) <> Cells(i, 7) And Cells(i, 5) <> Cells(i, 8) And Cells(i, 5) <> Cells(i, 9) _
Then fives True Else fives False
If Cells(i, 6) <> Cells(i, 7) And Cells(i, 6) <> Cells(i, 8) And Cells(i, 6) <> Cells(i, 9) _
Then sixes True Else sixes False
If Cells(i, 7) <> Cells(i, 8) And Cells(i, 7) <> Cells(i, 9) _
Then sevens True Else: sevens False
If Cells(i, 8) <> Cells(i, 9) _
Then eights True Else eights False
If ones And twos And threes And fours And fives And sixes And sevens And eights True Then Cells(i, 10).Interior.Color vbGreen Else Cells(i, 10).Interior.Color = vbBlue And MsgBox("Row " & i & " has a repeated value")
Next i
End Function
Function isColUnique(Inrange) As Boolean
Dim ones As Boolean
Dim twos As Boolean
Dim threes As Boolean
Dim fours As Boolean
Dim fives As Boolean
Dim sixes As Boolean
Dim sevens As Boolean
Dim eights As Boolean
Dim i As Integer
For i = 1 To 9
If Cells(1, i) <> Cells(2, i) And Cells(1, i) <> Cells(3, i) And Cells(1, i) <> Cells(4, i) And Cells(1, i) <> Cells(5, i) And Cells(1, i) <> Cells(6, i) And Cells(1, i) <> Cells(7, i) And Cells(1, i) <> Cells(8, i) And Cells(1, i) <> Cells(9, i) _
Then ones True Else ones False
If Cells(2, i) <> Cells(3, i) And Cells(2, i) <> Cells(4, i) And Cells(2, i) <> Cells(5, i) And Cells(2, i) <> Cells(6, i) And Cells(2, i) <> Cells(7, i) And Cells(2, i) <> Cells(8, i) And Cells(2, i) <> Cells(9, i) _
Then twos True Else twos False
If Cells(3, i) <> Cells(4, i) And Cells(3, i) <> Cells(5, i) And Cells(3, i) <> Cells(6, i) And Cells(3, i) <> Cells(7, i) And Cells(3, i) <> Cells(8, i) And Cells(3, i) <> Cells(9, i) _
Then threes True Else threes False
If Cells(4, i) <> Cells(5, i) And Cells(4, i) <> Cells(6, i) And Cells(4, i) <> Cells(7, i) And Cells(4, i) <> Cells(8, i) And Cells(4, i) <> Cells(9, i) _
Then fours True Else fours False
If Cells(5, i) <> Cells(6, i) And Cells(5, i) <> Cells(7, i) And Cells(5, i) <> Cells(8, i) And Cells(5, i) <> Cells(9, i) _
Then fives True Else fives False
If Cells(6, i) <> Cells(7, i) And Cells(6, i) <> Cells(8, i) And Cells(6, i) <> Cells(9, i) _
Then sixes True Else sixes False
If Cells(7, i) <> Cells(8, i) And Cells(7, i) <> Cells(9, i) _
Then sevens True Else: sevens False
If Cells(8, i) <> Cells(9, i) _
Then eights True Else eights False
If ones And twos And threes And fours And fives And sixes And sevens And eights = True _
Then Cells(10, i).Interior.Color = vbGreen Else _
Cells(10, i).Interior.Color = RGB(225, 0, 0) And MsgBox("coloum " & i & " has a repeated value")
Next i
End Function
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
AlKatou
Messages postés95Date d'inscriptionvendredi 7 février 2003StatutMembreDernière intervention28 novembre 2017 24 févr. 2011 à 18:01
salut
je n'ai pas regardé plus en détail le code appliqué dans ta fonction is3x3Unique. Mais ce que je peux te dire est que son code ne scrute pas la variable passée en paramètre (Inrange) d'où le fait qu'elle démarre de A1.
