Sujet Précédent Sujet Suivant

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

A voir également:

8 réponses

Réponse 1 / 8
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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
Réponse 2 / 8
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
Réponse 3 / 8
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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
Réponse 4 / 8
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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

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

Posez votre question
Réponse 5 / 8
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
Jack
 
Vraiment personne pour m'aider pls?
0
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
Bonjour,

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

eric
0
Jack
 
Ok, voici un fichier exemple: http://cjoint.com/?3GgmMGj6h7Y
0
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
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
Jack
 
Oui, en effet je me suis tromper de version. Le voila:
http://cjoint.com/?3GgnOeYfBqb
0
Réponse 6 / 8
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
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
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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
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
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
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
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
Réponse 7 / 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
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
Bon, je te laisse avancer alors, le fichier que tu as déposé ne sera plus valable...
eric
0
Réponse 8 / 8
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
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 715
 
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

Formule taux de marque
vcloclo1 -
vcloclo1 -

26 réponses
Tableau croisé dynamique - absence de certaines données
crazyrider71 -
Hana -

4 réponses
generateur de combinaison du loto 5/90
Riccilo -
ccm81 -

3 réponses