Lire un tableau via VBA pour remplir un formulaire

**kimai** · 05/07/2012, 18h19

Bonjour à tous,
Je vous explique mon problème.
J'ai le tableau suivant:

Ref A B C D E F
AAA -1 1
BBB -2 1 1
CCC -2 -1 1 2

avec des références (AAA, BBB, CCC)
et des emplacements ( A ... F)

la clé de lecture est la suivante:
- si pas de chiffre on ne fait rien
- si chiffre négatif on enlève la référence de l'emplacement correspondant
- si chiffre positif on ajoute la référence de l'emplacement correspondant

Voici donc le résultat que j'aimerais obtenir à partir du tableau ci-dessus

Ref De Vers
AAA C D
BBB A E
BBB A F
CCC B D
CCC B F
CCC C F

Vous remarquerez que pour le cas de l'emplacement "CCC" il n'y a pas besoin de tenir compte d'un chemin en particulier, il faut que:
- 2 références "CCC" quittent l'emplacement "B"
- 1 référence "CCC" quitte l'emplacement "C"
- 1 référence "CCC" aille vers l'emplacement "D"
- 2 référenceS "CCC" aillent vers l'emplacement "F"
On se fiche de savoir si on va de B vers D ou B vers F

Autre point important, la somme des lignes est toujours égales à 0, donc il n'y a jamais de référence qui se retrouve sans emplacement

J'ai commencé à imbrique les IF Then Elseif , avec des fonctions de valeurs absolues et de signe mais je n'y arrive vraiment pas

bon à savoir:
- le nombre de référence peut être illimitée
- il y a 20 emplacements possible au maximum

Si une bonne âme pouvait m'aider, je lui en serai reconnaissante.

Julie

PS: les tableaux ne donnant rien de visible j'ai attaché la photo du tableau initial et du résultat souhaité

**Bear the french** · 05/07/2012, 21h46

Bonsoir Julie,

J'ai considéré que la mise en forme se faisait sur un nouveau tableau en onglet "Feuil2".

Je considère que ton tableau peut avoir plus de lignes que les 3 de l'exemple mais que les colonnes ont été limitées à 6 (A B C D E F)

Voilà la base qui doit fonctionner sous VBA Excel :

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
Sub miseenforme()
 
Dim x, y, taille As Double
Dim somme, numligne As Integer
 
numligne = 2
somme = 0
x = 1
y = 0
 
' nombre de ligne sur le tableau d'origine
taille = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
 
' initialisation et présentation sur la Feuil2
Sheets("Feuil2").Cells.ClearContents
Sheets("Feuil2").Cells(1, 1).Value = "Ref"
Sheets("Feuil2").Cells(1, 2).Value = "De"
Sheets("Feuil2").Cells(1, 3).Value = "Vers"
 
' chargement de la liste sur 6 colonnes
' puis remplissage au fur et à mesure de la Feuil2
ReDim tabl(taille, 7) As Variant
For Each cell In Sheets("Feuil1").Range(Cells(2, 2), Cells(taille, 7))
    y = y + 1
    tabl(x, y) = cell.Value
    Do While tabl(x, y) <> 0
        If tabl(x, y) < 0 Then
            Sheets("Feuil2").Cells(Sheets("Feuil2").Range("B" & Rows.Count).End(xlUp).Row + 1, 2).Value = Sheets("Feuil1").Cells(1, y + 1).Value
            tabl(x, y) = tabl(x, y) + 1
        End If
        If tabl(x, y) > 0 Then
            Sheets("Feuil2").Cells(Sheets("Feuil2").Range("C" & Rows.Count).End(xlUp).Row + 1, 3).Value = Sheets("Feuil1").Cells(1, y + 1).Value
            tabl(x, y) = tabl(x, y) - 1
        End If
    Loop
    If y = 6 Then y = 1 And x = x + 1
Next
 
'Mise en place des titres de ligne
For i = 2 To taille
    For Each cell In Sheets("Feuil1").Range(Cells(i, 2), Cells(i, 7))
        somme = somme + Abs(cell)
    Next
    numligne = somme / 2
    For j = 1 To numligne
        Sheets("Feuil2").Cells(Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row + 1, 1).Value = Sheets("Feuil1").Cells(i, 1).Value
    Next
    somme = 0
Next
 
End Sub