Condition tableau VBA

Jack -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

J'ai réalisé une macro qui stocke dans un tableau dynamique les numéros de ligne de certaine cellules.
A la fin je voudrais que, si le tableau contient un unique élément que certaines cellules soit égale à des cellules de la ligne stockées.
Le problème se situe à ce niveau apparament "Cells(tab_bd(0), 6)", tab_bd(0) est censé représenté l'unique élément du tableau et donc le numéro de la ligne qui m'intéresse, mais ça ne marche pas.
De plus, pour dire que le tableau contient un unique élément j'ai utilisé "UBound(tab_bd) = 0", je ne sais pas si c'est bon aussi...

If UBound(tab_bd) = 0 Then
Cells(i, 29).Value = Cells(tab_bd(0), 6).Offset(0, 23).Value
End If

Merci d'avance

8 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,
    Ubound est egal a la definition du tableau soit par: ex dim S(12), Ubound(S)=12
    Dim S() et un ReDim,Ubound prend la valeur definie par ReDim.

    Pour savoir si vous n'avez qu'une ligne dans votre tableau, testez tab_bd(1)=0 en prenant soin de faire un Erase tab_bd avant chaque tour de programme.

    Bonne suite
    0
  2. Jack
     
    Merci de ces précisions, mais ça ne marche toujours pas il me dit que ça n'appartient pas à la sélection. Je vais joindre le code complet, peut-être que l'erreur est plus en amont.

    Sub Completor()

    Dim Wbk As Workbook
    Dim cell As Range
    Dim plage As Range
    Dim line_insertion As Integer

    Set Wbk = Workbooks("Test nutrition.xls")
    Set plage = Wbk.Worksheets("Structure").Range("F6:" & Range("F6").End(xlDown).Address)

    Dim tab_bd()
    ReDim tab_bd(line_insertion)

    line_insertion = 0

    For i = 3 To Cells(3, 6).End(xlDown).Row

    If Cells(i, 36) = 0 Then
    Erase tab_bd
    For Each cell In plage

    If i <> cell.Row And cell.Offset(0, 30) <> 0 Then

    If (Cells(i, 6).Value = cell.Value) And (Cells(i, 5).Value = cell.Offset(0, -1).Value) And (Cells(i, 7).Value = cell.Offset(0, 1).Value) Then
    ReDim tab_bd(line_insertion)
    tab_bd(line_insertion) = cell.Row
    line_insertion = line_insertion + 1

    End If

    End If

    Next cell

    If tab_bd(1) = 0 Then
    Cells(i, 29).Value = Cells(tab_bd(0), 6).Offset(0, 23).Value
    Cells(i, 30).Value = Cells(tab_bd(0), 6).Offset(0, 24).Value
    Cells(i, 31).Value = Cells(tab_bd(0), 6).Offset(0, 25).Value
    Cells(i, 32).Value = Cells(tab_bd(0), 6).Offset(0, 26).Value
    Cells(i, 33).Value = Cells(tab_bd(0), 6).Offset(0, 27).Value
    Cells(i, 34).Value = Cells(tab_bd(0), 6).Offset(0, 28).Value
    Cells(i, 35).Value = Cells(tab_bd(0), 6).Offset(0, 29).Value
    Cells(i, 36).Value = Cells(tab_bd(0), 6).Offset(0, 30).Value
    Cells(i, 37).Value = Cells(tab_bd(0), 6).Offset(0, 31).Value
    End If

    End If

    Next i

    End Sub
    0
  3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    le premier ReDim tab_bd(line_insertion) ne sert a rien.

    Au deuxieme ReDim tab_bd(line_insertion):
    vous effacez a chaque tour les donnees de votre tableau

    ReDim Preserve tab_bd(line_insertion) pour redimensionner en gardant les donnees precedentes.

    A suivre
    0
  4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,
    Une solution avec test Ubound(Tab_bd)=0 (tout est dans la definition de la variable tab_bd et pas d'erase) 

    Sub Completor() 

  Dim Wbk As Workbook 
  Dim cell As Range 
  Dim plage As Range 
  Dim line_insertion As Integer 
  Dim tab_bd 

  Set Wbk = Workbooks("Test nutrition.xls") 
  Set plage = Wbk.Worksheets("Structure").Range("F6:" & Range("F6").End(xlDown).Address) 

  For i = 3 To Cells(3, 6).End(xlDown).Row 
    line_insertion = 0 
    If Cells(i, 36) = 0 Then 
      ReDim tab_bd(0) 
      For Each cell In plage 
        If i <> cell.Row And cell.Offset(0, 30) <> 0 Then 
          If (Cells(i, 6).Value = cell.Value) And _ 
             (Cells(i, 5).Value = cell.Offset(0, -1).Value) And _ 
             (Cells(i, 7).Value = cell.Offset(0, 1).Value) Then 
            ReDim Preserve tab_bd(line_insertion) 
            tab_bd(line_insertion) = cell.Row 
            line_insertion = line_insertion + 1 
          End If 
        End If 
      Next cell 

      If UBound(tab_bd) = 0 Then 
        Cells(i, 29).Value = Cells(tab_bd(0), 6).Offset(0, 23).Value 
        Cells(i, 30).Value = Cells(tab_bd(0), 6).Offset(0, 24).Value 
        Cells(i, 31).Value = Cells(tab_bd(0), 6).Offset(0, 25).Value 
        Cells(i, 32).Value = Cells(tab_bd(0), 6).Offset(0, 26).Value 
        Cells(i, 33).Value = Cells(tab_bd(0), 6).Offset(0, 27).Value 
        Cells(i, 34).Value = Cells(tab_bd(0), 6).Offset(0, 28).Value 
        Cells(i, 35).Value = Cells(tab_bd(0), 6).Offset(0, 29).Value 
        Cells(i, 36).Value = Cells(tab_bd(0), 6).Offset(0, 30).Value 
        Cells(i, 37).Value = Cells(tab_bd(0), 6).Offset(0, 31).Value 
      End If 
    End If 
  Next i 
End Sub


    Bonne suite
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Jack
     
    Bonjour,

    Merci de votre aide, mais il y toujours un problème à cette ligne:
    Cells(i, 29).Value = Cells(tab_bd(0), 6).Offset(0, 23).Value
    Il me dit "erreur définie par l'application ou l'objet"
    0
    1. Jack
       
      Vraiment personne pour m'aider pls?
      0
    2. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Bonjour,

      si tu joignais un fichier ça motiverait peut-être pour regarder.
      cjoint.com et coller ici le lien fourni

      eric
      0
    3. Jack
       
      Ok, voici un fichier exemple: http://cjoint.com/?3GgmMGj6h7Y
      0
    4. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      re,

      il me semble que c'est ton fichier initial sans tenir compte des remarques et propositions de f894009.
      On reverra ça lorsque tu en auras tenu compte

      eric
      0
    5. Jack
       
      Oui, en effet je me suis tromper de version. Le voila:
      http://cjoint.com/?3GgnOeYfBqb
      0
  7. Jack
     
    Le bug est corrigé mais le programme ne fait pas ce que je veux. Je m'explique, l'objectif de ce programme est de remplir la partie surligné en jaune de la manière suivante:
    Il parcourt la colonne AJ et dès qu'il trouve une case vide, il compare les cellules "Cat Name", "Name" et "Name2" de cette ligne avec le reste de la liste:
    1er cas: S'il trouve une concordance parfaite avec une autre ligne dont les cases AD:AL sont remplie, il recopie ces données.
    2ème cas: S'il trouve une concordance parfaite avec plusieurs autres lignes, il inscrit dans la case AD, le numéro des lignes trouvées.
    3ème cas: Il ne trouve rien et dans ce cas il me dit "not found" dans la case AD.

    Pour l'instant ce que j'ai essayé de faire était le premier cas, mais il ne marche (la ligne 15 devrait être complétée, mais il ne se passe rien).
    0
    1. Jack
       
      Le tableau servait à stocker les numéros de lignes trouvée, s'il n'avait qu'un élément on était dans le cas 1, aucun élément cas 3 et plusieurs éléments cas 2. C'est pour ça que j'ai pensé à l'utilisation d'un tableau.
      0
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      1er cas : Meat and Poultry Chicken Broilers & egg-producing ce groupe de cellule est unique sur la premiere ligne vide de AJ donc ??????
      0
    3. Jack
       
      Donc, on le compare au reste de la liste et comme il n'y a pas d'autre ligne avec les mêmes cat name, name et name2, on écrit "not found" en AD10.
      0
    4. Jack
       
      En fait, dès qu'on tombe sur un AJ vide, on compare à tous les autres éléments de la liste. Si on ne trouve qu'une seule autre ligne (donc au total ça fait deux avec la ligne de référence) avec les cat name, name et name2 identiques et dont la cellule AJ N'EST PAS VIDE, alors on recopie les données qui nous intéresse.
      0
    5. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Pas trop le temps de regarder dans le détail mais...
      pourquoi F6 dans : 
      Set plage = Wbk.Worksheets("Structure").Range("F6:" & Range("F6").End(xlDown).Address)
      et pas F3 ?

      et
      il compare les cellules "Cat Name", "Name" et "Name2"... qui sont en D:F
      Alors pourquoi : 
                If (Cells(i, 6).Value = cell.Value) And _  
             (Cells(i, 5).Value = cell.Offset(0, -1).Value) And _  
             (Cells(i, 7).Value = cell.Offset(0, 1).Value) Then
      qui sont E:G ?

      eric
      0
  8. Jack
     
    Je ne sais par quelle miracle, mais le 1er cas fonctionne maintenant alors que je n'ai touché à rien de plus. Je vais essayé de programmer les autres cas.
    0
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Bon, je te laisse avancer alors, le fichier que tu as déposé ne sera plus valable...
      eric
      0
  9. Jack
     
    ça y est finalement ça marche, je vous joint le code si vous voulez jetez un oeil.
    En tout cas merci beaucoup pour votre aide f894009 et eriiic.

    Sub Completor()

    Dim Wbk As Workbook
    Dim cell As Range
    Dim plage As Range
    Dim line_insertion As Integer
    Dim tab_bd
    Dim msg As String

    Set Wbk = Workbooks("Test nutrition.xls")
    Set plage = Wbk.Worksheets("Structure").Range("F3:" & Range("F3").End(xlDown).Address)

    Wbk.Worksheets("Structure").Activate

    For i = 3 To Cells(3, 6).End(xlDown).Row
    line_insertion = 0
    If Cells(i, 36) = 0 Then
    ReDim tab_bd(0)
    For Each cell In plage
    If i <> cell.Row And cell.Offset(0, 30) <> 0 Then
    If (Cells(i, 6).Value = cell.Value) And (Cells(i, 5).Value = cell.Offset(0, -1).Value) And (Cells(i, 7).Value = cell.Offset(0, 1).Value) Then
    ReDim Preserve tab_bd(line_insertion)
    tab_bd(line_insertion) = cell.Row
    line_insertion = line_insertion + 1
    Else
    Cells(i, 30).Value = "not found"
    End If
    End If
    Next cell

    If UBound(tab_bd) = 0 And line_insertion = 1 Then
    Cells(i, 30).Value = Cells(tab_bd(0), 6).Offset(0, 24).Value
    Cells(i, 31).Value = Cells(tab_bd(0), 6).Offset(0, 25).Value
    Cells(i, 32).Value = Cells(tab_bd(0), 6).Offset(0, 26).Value
    Cells(i, 33).Value = Cells(tab_bd(0), 6).Offset(0, 27).Value
    Cells(i, 34).Value = Cells(tab_bd(0), 6).Offset(0, 28).Value
    Cells(i, 35).Value = Cells(tab_bd(0), 6).Offset(0, 29).Value
    Cells(i, 36).Value = Cells(tab_bd(0), 6).Offset(0, 30).Value
    Cells(i, 37).Value = Cells(tab_bd(0), 6).Offset(0, 31).Value
    Cells(i, 38).Value = Cells(tab_bd(0), 6).Offset(0, 32).Value
    ElseIf UBound(tab_bd) > 0 Then
    For Z = 0 To UBound(tab_bd)
    msg = msg & tab_bd(Z) & ", "
    Next Z
    Cells(i, 30).Value = msg
    End If
    End If
    Next i
    End Sub
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,
      Si programme termine:

      'Remplacez
      Cells(i, 30).Value = Cells(tab_bd(0), 6).Offset(0, 24).Value
      Cells(i, 31).Value = Cells(tab_bd(0), 6).Offset(0, 25).Value
      Cells(i, 32).Value = Cells(tab_bd(0), 6).Offset(0, 26).Value
      Cells(i, 33).Value = Cells(tab_bd(0), 6).Offset(0, 27).Value
      Cells(i, 34).Value = Cells(tab_bd(0), 6).Offset(0, 28).Value
      Cells(i, 35).Value = Cells(tab_bd(0), 6).Offset(0, 29).Value
      Cells(i, 36).Value = Cells(tab_bd(0), 6).Offset(0, 30).Value
      Cells(i, 37).Value = Cells(tab_bd(0), 6).Offset(0, 31).Value
      Cells(i, 38).Value = Cells(tab_bd(0), 6).Offset(0, 32).Value
      'par
      Range(Cells(tab_bd(0), 6).Offset(0, 24), Cells(tab_bd(0), 6).Offset(0, 32)).Copy Cells(i, 30)
      'ou copie sans de format cellule
      Range(Cells(i, 30), Cells(i, 38)).Value = Range(Cells(tab_bd(0), 6).Offset(0, 24), Cells(tab_bd(0), 6).Offset(0, 32)).Value


      Bonne suite
      0

Discussions similaires

Tableau (croisé dynamique?) à 3 entrées
ClementH3o -
ClementH3o -

10 réponses
Téléphone en condition optimale...?
Elka_3079 -
Baleinotte -

2 réponses
Formule taux de marque
vcloclo1 -
vcloclo1 -

26 réponses