Condition tableau VBA

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

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

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

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

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"

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).

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.

ç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