Transférer de tableau a vers tableau b

Bonjour,

Je sèche lamentablement par ma méconnaissance des tableaux (qui, comme les dictionnaires, me donnent du fil à retordre).

Je voudrais scanner un tableau a() et pour le maximum trouvé dans une ligne (sur 6 colonnes), insérer dans un autre tableau b() autant de lignes que ce maximum trouvé et aussi la donnée qui correspond à ce maximum .

Le avant et le après sont dans mon classeur exemple (XL 2010 ou 2016)

Merci !

Ma patience est inversement proportionnelle à mes connaissances du vba s'y trouvent, c'est à dire pas loin par rapport aux ténors du forum

P.

Bonjour,

Sub essai()
  Num = [A2:A4]
  Vehic = [B2:G4]
  entete = [B1:G1]
  Dim Result()
  Ncol = UBound(Vehic, 2)
  j = 1
  For i = LBound(Vehic) To UBound(Vehic)
    ligne = Application.Index(Vehic, i)
    mx = Application.Max(ligne)
    pmx = Application.Match(mx, ligne, 0)
    ReDim Preserve Result(1 To Ncol + 1, 1 To mx + j)
    For lig = j To j + mx - 1
      Result(1, lig) = Num(i, 1)
      Result(pmx + 1, lig) = entete(1, pmx)
      j = j + 1
    Next lig
  Next i
  [s2].Resize(UBound(Result, 2), Ncol + 1) = Application.Transpose(Result)
  [t1].Resize(, UBound(entete, 2)) = entete
End Sub

Application.Match sur un Array peut être lent. Peut être remplacé par:

Function PosTbl(Tbl, colonne, Valeur)
  For i = LBound(Tbl) To UBound(Tbl)
    If Tbl(i, colonne) = Valeur Then PosTbl = i: Exit Function
  Next i
  PosTbl = 0
End Function

Ceuzin

Bonjour

il faut faire attention avec les tableaux, pour les redimensionner si tu utilise l'instruction

redim 

, il efface le contenu du tableau ....

il faut donc utiliser

redim preserve

mais ce qui est ennuyeux avec redim preserve c'est qu'il n'est capable que de redimensionner la dernière dimension c'est à dire pour un tableau à deux entrées que le nombre de colonnes et non pas le nombre de lignes comme tu voudrais... donc il faut faire un peu de gymnastique

si je peux te proposer un site qui regroupe bcp d'informations là dessus :

http://boisgontierjacques.free.fr/pages_site/tableaux.htm

tu trouveras donc dans le fichier joint une proposition qui a priori fait ce que tu demandes avec les tableaux j'ai juste changé la destination du collage des cellules

si besoin de plus d'info...

Fred

Bonjour à tous

Patrick, pour t'aider :

Sub test()
    a = [A1].CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        maxi = Application.Max(Application.Index(a, i, Evaluate("row(2:" & UBound(a, 2) & ")")))
        MsgBox "la valeur maximum de la ligne " & i & " est " & maxi
    Next
End Sub

klin89

re

Super rapides les réponses et intéressantes ces 2 versions !

Celle de Fred a ma préférence, et je vais tenter de la comprendre pour l'appliquer sur mon fichier très proche de l'exemple ..

Merci beaucoup

P.

ps Fred: malgré que je connaisse l'excellent site de Jacques, je n'y suis pas arrivé

re c'est pour cela que j'avais garde une partie de ton code pour que tu ne sois pas "perdu".... mais la solution de Creuzin est plus optimisée...

fred

Klin89 a écrit :

Bonjour à tous

Patrick, pour t'aider :

Sub test()
    a = [A1].CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        maxi = Application.Max(Application.Index(a, i, Evaluate("row(2:" & UBound(a, 2) & ")")))
        MsgBox "la valeur maximum de la ligne " & i & " est " & maxi
    Next
End Sub

klin89

Ce qui évite de boucler sur les colonnes donc ...

Merci