IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

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


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre habitué
    Profil pro
    Inscrit en
    Février 2008
    Messages
    13
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2008
    Messages : 13
    Par défaut Remplir 2 tableaux via une fonction booléenne filtrant sur un tableau
    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
    Fichiers attachés Fichiers attachés

  2. #2
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    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

  3. #3
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 162
    Billets dans le blog
    53
    Par défaut
    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 la fonction renvoie VRAI
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  4. #4
    Membre Expert
    Profil pro
    Inscrit en
    Juin 2009
    Messages
    652
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juin 2009
    Messages : 652
    Par défaut
    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

  5. #5
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Bonjour à tous,

    @Philippe :

    Comme l'option est positionnée :

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

  6. #6
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 162
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 162
    Billets dans le blog
    53
    Par défaut
    Bonjour Daniel,

    Au temps pour moi, je m'étais focalisé sur la fonction et n'avais pas regardé l'ensemble du module.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. remplir un tableau de structure via une fonction
    Par B65AcR dans le forum Débuter
    Réponses: 2
    Dernier message: 07/01/2014, 17h06
  2. remplir une zone de liste via une fonction
    Par marinaetsonchat dans le forum VBA Access
    Réponses: 1
    Dernier message: 22/08/2011, 12h57
  3. Réponses: 4
    Dernier message: 21/09/2008, 01h24
  4. Retourner 2 tableaux d'une fonction...
    Par TigreRouge dans le forum Langage
    Réponses: 4
    Dernier message: 04/04/2006, 14h32
  5. Réponses: 7
    Dernier message: 20/03/2005, 14h53

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo