Remplir 2 tableaux via une fonction booléenne filtrant sur un tableau

**Elvaiz** · 24/03/2013, 01h13

Bonjour à tous,

Je cherche à filtrer depuis un tableau via une fonction booléene afin de tirer depuis ce tableau, deux tableaux distincts.

L'exemple que j'utilise pour cet exercice est un filtre sur une série de mots (en l’occurrence le code phonétique international , donc 26 mots que je souhaite trier en fonction du fait que la première lettre soit une voyelle ou consonne, afin d'obtenir par la suite, un tableau de mots de consonnes et un tableau de mots de voyelles.

Mais j'ai des problèmes dans le renvoi depuis la fonction pour alimenter ces tableaux.

J’avoue que je patauge, j'ai essayé de résoudre seul , puis d'utiliser les forums afin de voir les exemples, j'arrive à remplir les conditions, mais je n'arrive pas à retourner de quoi alimenter mes tableaux et je suis perdu.

Je vous remercie d'avance pour vos réponses qui me permettront de continuer de l'avant en VBA

PS : PMO, Thèze, votre aide de la dernière fois m'a été d'un très grand secours, merci beaucoup

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Option Explicit
Option Compare Text
 
Global ThisWorkbook As Workbook
Global MyMainSheet As Worksheet
Global i, j, cmpti, cmptj As Integer
 
Sub AjoutValeurs()
 
 
      Dim TabInput()
 
      Set ThisWorkbook = ActiveWorkbook
      Set MyMainSheet = ThisWorkbook.Worksheets("Sheet1")
      MyMainSheet.Select
      Dim TabRNG()
      TabRNG = MyMainSheet.Range(Cells(3, 2), Cells(3, 2).End(xlDown))
      Dim MytabCons() As String
      Dim MytabVoy() As String
 
      Dim MotTest()
 
 
 
      For i = 1 To UBound(TabRNG, 1)
        For j = 1 To 1
 
          MsgBox TabRNG(i, j)
          MotTest = TabRNG
          'ConsOuVoy (MotTest(i, j))
          MytabCons(i, j) = EstConsonne(MotTest(i, j))
          MytabVoy(i, j) = EstConsonne(MotTest(i, j))
 
 
 
        Next j
      Next i
 
      MyMainSheet.Range(Cells(3, 4), Cells(3, 4).End(xlDown)) = MytabCons
      MyMainSheet.Range(Cells(3, 5), Cells(3, 5).End(xlDown)) = MytabVoy
 
End Sub
 
 
 
Function EstConsonne(ByVal MotTest As String) As Boolean
 
    Dim motConsonne As String
    Dim motVoyelle As String
 
    If Left(CStr(MotTest), 1) = "a" Or Left(CStr(MotTest), 1) = "e" Or Left(CStr(MotTest), 1) = "i" Or Left(CStr(MotTest), 1) = "u" Then
 
        MsgBox MotTest & " commence par une voyelle "
 
        motVoyelle = MotTest
        EstConsonne = False
 
    Else
        MsgBox MotTest & " commence par une consonne"
        EstConsonne = True
    End If
 
 
    If EstConsonne = True Then
      EstConsonne = MotTest
 
 
 
    Else
 
      motVoyelle = MotTest
 
    End If
 
 
End Function

**Daniel.C** · 24/03/2013, 11h08

Bonjour,

J'ai modifié la fonction "Estconsonne" comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function EstConsonne(ByVal MotTest As String) As Boolean
 
    Dim motConsonne As String
    Dim motVoyelle As String
 
    If Left(CStr(MotTest), 1) = "a" Or Left(CStr(MotTest), 1) = "e" Or Left(CStr(MotTest), 1) = "i" Or Left(CStr(MotTest), 1) = "u" Then
 
        'MsgBox MotTest & " commence par une voyelle "
 
        motVoyelle = MotTest
        EstConsonne = False
 
    Else
        'MsgBox MotTest & " commence par une consonne"
        EstConsonne = True
    End If
 
 
 
 
End Function

Il manque le "y" comme voyelle; je ne l'ai pas ajoouté, ne sachant pas si l'omission était intentionnelle...

Pour les tableaux :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test()
    Dim C As Range
    [A2] = "Lettre"
    [B2] = "Nom"
    For Each C In [C3:C28]
        C.Formula = "=estconsonne(B" & C.Row() & ")"
    Next C
    ActiveSheet.AutoFilterMode = False
    [A2:C28].AutoFilter 3, "FAUX"
    [B3:B28].SpecialCells(xlCellTypeVisible).Copy [E3]
    ActiveSheet.AutoFilterMode = False
    [A2:C28].AutoFilter 3, "VRAI"
    [B3:B28].SpecialCells(xlCellTypeVisible).Copy [D3]
    ActiveSheet.AutoFilterMode = False
End Sub

**Philippe Tulliez** · 24/03/2013, 11h28

Bonjour Daniel,
Dans la fonction EstConsonne, je ferais le test avec la majuscule (Ucase) de la première lettre du mot ou du mot complet ce qui est encore plus simple.
Parce-que si tu testes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=EstConsonne("Avion")

la fonction renvoie VRAI

**PMO2017** · 24/03/2013, 11h39

Bonjour,

Essayez avec votre code modifié

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Global WB As Workbook
Global MyMainSheet As Worksheet
'/// Global i, j, cmpti, cmptj As Integer  'Pas bon : seul cmptj est Integer (toutes les autres variables sont Variant)
 
Sub AjoutValeurs()
Dim TabRNG As Variant
Dim MytabCons() As String
Dim MytabVoy() As String
Dim i As Integer
Dim j As Integer
Dim cmptCons As Integer
Dim cmptVoy As Integer
'/// NON : ThisWorkbook est un mot réservé qui référence le classeur contenant la macro ///
''''Set ThisWorkbook = ActiveWorkbook   'Pas bon
Set WB = ActiveWorkbook
'//////////////////////////////////////////////////////////////////////////////////////////
Set MyMainSheet = WB.Worksheets("Sheet1")
MyMainSheet.Select  'pas utile
TabRNG = MyMainSheet.Range(MyMainSheet.Cells(3, 2), MyMainSheet.Cells(3, 2).End(xlDown))  'plage B3 : B28 (1 seule colonne donc)
'---
For i = 1 To UBound(TabRNG, 1)
  For j = 1 To 1
    If Not EstConsonne(TabRNG(i, j)) Then
      cmptCons = cmptCons + 1
      ReDim Preserve MytabCons(1 To 1, 1 To cmptCons)
      MytabCons(1, cmptCons) = TabRNG(i, j)
    Else
      cmptVoy = cmptVoy + 1
      ReDim Preserve MytabVoy(1 To 1, 1 To cmptVoy)
      MytabVoy(1, cmptVoy) = TabRNG(i, j)
    End If
  Next j
Next i
MyMainSheet.Range(Cells(3, 4), Cells(cmptCons + 2, 4)) = Application.WorksheetFunction.Transpose(MytabCons)
MyMainSheet.Range(Cells(3, 5), Cells(cmptVoy + 2, 5)) = Application.WorksheetFunction.Transpose(MytabVoy)
End Sub
 
Function EstConsonne(ByVal MotTest As String) As Boolean
Dim motConsonne As String
Dim motVoyelle As String
Dim Voyelles As Variant
Dim i&
Voyelles = Array("a", "e", "i", "o", "u")
For i& = LBound(Voyelles) To UBound(Voyelles)
  If Left(Trim(MotTest), 1) = Voyelles(i&) Or Left(Trim(MotTest), 1) = UCase(Voyelles(i&)) Then
    EstConsonne = True
    Exit For
  End If
Next i&
End Function