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

**Daniel.C** · 24/03/2013, 12h35

Bonjour à tous,

@Philippe :

Comme l'option est positionnée :

Code :

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

Option Compare Text

Il n'y a pas de problème de casse.

**Philippe Tulliez** · 24/03/2013, 13h36

Bonjour Daniel,

Au temps pour moi, je m'étais focalisé sur la fonction et n'avais pas regardé l'ensemble du module.

**Daniel.C** · 24/03/2013, 15h23

Au temps pour moi, je m'étais focalisé sur la fonction et n'avais pas regardé l'ensemble du module.

A vrai dire, comme le résultat était correct, je ne m'étais pas posé de question. C'est ta remarque qui m' a fait chercher.

**Elvaiz** · 25/03/2013, 13h02

Bonjour à tous,

Je tiens à vous remercier infiniment pour vos réponses.
Si j'ai mis un peu de temps à vous répondre, c'est parce que je me suis plongé dans les réponses pour essayer de les comprendre et d'essayer de vous revenir avec un maximum de retour de ma part, avec les limites de mes connaissances.

@ PMO : votre code fonctionne parfaitement et je l'ai adapté.
Je crois avori compris la logique à l'exception de quelques points que j'aimerai que vous m'expliquiez s'il vous plait :

Voici le code que j'ai écris

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
Option Explicit
 
Global Wkbook As Workbook
Global MyMainSheet As Worksheet
 
 
Sub Ajoutvaleurs()
 
    Dim MyTabRNG As Variant
    Dim MyTabCons() As String
    Dim MyTabVoy() As String
 
    Set Wkbook = ActiveWorkbook
    Set MyMainSheet = Wkbook.Worksheets("Sheet1")
 
    MyTabRNG = MyMainSheet.Range(Cells(3, 2), Cells(3, 2).End(xlDown))
 
    Dim i, j As Integer
 
    Dim cmptCons, cmptVoy As Integer
 
    MyTabRNG = MyMainSheet.Range(Cells(3, 2), Cells(3, 2).End(xlDown))
 
 
    For i = 1 To UBound(MyTabRNG, 1)
        For j = 1 To 1
 
              'MsgBox MyTabRNG(i, j)
 
              If Not EstVoyelle(MyTabRNG(i, j)) Then
              cmptCons = cmptCons + 1
              ReDim Preserve MyTabCons(1 To 1, 1 To cmptCons)
              MyTabCons(1, cmptCons) = MyTabRNG(i, j)
 
              Else
 
              cmptVoy = cmptVoy + 1
              ReDim Preserve MyTabVoy(1 To 1, 1 To cmptVoy)
              MyTabVoy(1, cmptVoy) = MyTabRNG(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
 
 
Public Function EstVoyelle(ByVal motTest As String) As Boolean
 
 
  Dim motConsonne As String
  Dim motVoyelle As String
 
  Dim Voyelles As Variant
  'Dim Consonne 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
 
        EstVoyelle = True
        Exit For
 
      End If
  Next i
End Function

J'ai modifié la fonction car il me semble car vous posez que EstConsonne = true lorsque la 1ere lettre est égale à une voyelle mais cela ne change pas le résultat, cela fonctionne à merveille. ( que l'on mette P(X) = 1- P(Y) ou P(Y) = 1- P(X), cela ne change rien)

Par contre, je ne comprends pas pourquoi vous mettez

Code :

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

  MyTabCons(1, cmptCons) = MyTabRNG(i, j)

Est ce que vous pouvez m'expliquer SVP, car intuitivement, je mettrai

Code :

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

  MyTabCons( cmptCons,1) = MyTabRNG(i, j)

et cela ne fonctionne pas mais dans mon esprit , la table étant itérée en i ( en descendant ligne par ligne), on est à la dimension 1 de la table .
C'est cela que je ne comprends pas et j'imagine que ma logique est fausse, car cela ne fonctionne pas.

@Daniel : merci pour votre code, mais il va me falloir plus de temps pour l'analyser et faire un retour, j'essaie de comprendre la logique, mais il y a énormément de choses dans votre code qui sont totalement nouvelles pour moi ( ce qui est très bien, car j'ai pu avoir grâce à vous Messieurs, une solution proche de ce à quoi je voulais aboutir et une autre façon de faire) .
Je comprends que vous faites une filtration pour ensuite alimenter les deux tableaux mais c'est quelque chose de vraiment nouveau. Encore merci.

Cependant, le code ne fonctionne pas chez moi.
Je me permets de vous l'attacher tel que je l'ai intégré dans mon fichier et j'ai une erreur 1004: no cells were found à la ligne

Code :

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

[B3:B28].SpecialCells(xlCellTypeVisible).Copy [E3]

Encore merci à vous tous pour votre aide !

**Daniel.C** · 25/03/2013, 14h18

Bonjour,

Normal. Comme je le disais plus haut, tu dois mettre la ligne :

Code :

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

Option Compare Text

au début du module. Tel quel, toutes les lettres sont considérées comme des consonnes; tu ne filtres donc pas de voyelles et l'option "SpecialCells" provoque une erreur. Pour se prémunir contre l'absence de voyelles ou de consonnes, il faut modifier le code comme suit :

J'ai mis des commentaires dans la macro :

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
Sub test()
    Dim C As Range
    'ajout des entêtes nécessaires au filtre automatique
    [A2] = "Lettre"
    [B2] = "Nom"
    'ajout de la formule "estconsonne" en colonne C
    For Each C In [C3:C28]
        C.Formula = "=estconsonne(B" & C.Row() & ")"
    Next C
    'suppression d'un filtre s'il y en a déjà un
    ActiveSheet.AutoFilterMode = False
    'filtre de la colonne C sur "FAUX" (voyelle)
    [A2:C28].AutoFilter 3, "FAUX"
    's'il y a des lignes filtrées (Subtotal(103, [A:A]) compte les lignes visibles)
    If Application.Subtotal(103, [A:A]) > 1 Then
        'copie des mots commençant par des voyelles en E3
        [B3:B28].SpecialCells(xlCellTypeVisible).Copy [E3]
    End If
    ActiveSheet.AutoFilterMode = False
    [A2:C28].AutoFilter 3, "VRAI"
    's'il y a des lignes filtrées (Subtotal(103, [A:A]) compte les lignes visibles)
    If Application.Subtotal(103, [A:A]) > 1 Then
        'copie des mots commençant par des consonnes en D3
        [B3:B28].SpecialCells(xlCellTypeVisible).Copy [D3]
    End If
    ActiveSheet.AutoFilterMode = False
End Sub

**Elvaiz** · 25/03/2013, 14h41

Merci Daniel,

Cela fonctionne.
Je vais m'atteler à comprendre et à reproduire ta solution, y compris en l'adaptant à un autre exercice, pour voir si j'ai bien compris le fonctionnement et je te ferais un retour.
Merci infiniment

@PMO , je réfléchissais à une possible réponse au sujet de la question que je vous posais.
Je vais peut être mieux expliquer mon raisonnement afin que vous puissiez svp m'expliquer en quoi il est faux

Code :

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

  MyTabCons(1, cmptCons) = MyTabRNG(i, j)

Est ce que vous pouvez m'expliquer SVP, car intuitivement, je mettrai

Code :

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

  MyTabCons( cmptCons,1) = MyTabRNG(i, j)

Dans mon esprit MyTabCons(i,j) devrait s'écrire MyTabCons(cmptCons,j)
Comme j, à savoir la dimension largeur est d'une colonne, cela donne j=1
D'où MyTabCons(i,j) => MyTabCons(cmptCons,1)
Or, vous mettez MyTabCons(1 ,cmptCons) et c'est vous qui avez raison, mais je ne comprends pas la logique derrière .

Merci à vous tous pour votre aide

**Guiiand** · 25/03/2013, 15h12

Bonjour,

La réponse à ta question vient d'une limitation d'excel. On ne peut redimensionner que la dernière dimension d'un tableau. c'est pour cela que l'on fais

Code :

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

MyTabCons(1, cmptCons) = MyTabRNG(i, j)

et non

Code :

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

MyTabCons( cmptCons,1) = MyTabRNG(i, j)

**PMO2017** · 27/03/2013, 12h30

Bonjour Elvaiz,

Je ne sais pas pourquoi mais je n'ai pas été averti par E-mail de la suite des messages. Je réponds donc avec retard.

Or, vous mettez MyTabCons(1 ,cmptCons) et c'est vous qui avez raison, mais je ne comprends pas la logique derrière

Guiiand a tout expliqué

La réponse à ta question vient d'une limitation d'excel. On ne peut redimensionner que la dernière dimension d'un tableau.

C'est pour cette raison qu'on utilise Transpose dans les instructions suivantes qui ont pour effet de remettre les tableaux dans le sens requis.
Par exemple : si le tableau comporte 10 lignes et 20 colonnes, on le transpose pour obtenir un tableau de 20 lignes et 10 colonnes

Code :

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

1
2
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)

**Elvaiz** · 31/03/2013, 16h06

Bonjour à tous,

Merci beaucoup pour vos explications.
Je m'excuse car j'ai pris un peu plus de temps que je ne l'aurai souhaité pour comprendre vos réponses.
Mais je crois que j'ai à peu prêt tout assimilé. Je vérifie cela en faisant des exercices du même type.
En tout cas, pour le dernier point, ie , le redimensionnement de la dernière dimension, j'ai compris ! C'est super clair

Encore merci à vous tous pour votre aide !

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

Macros et VBA Excel

Discussions similaires

Partager

Partager