Discussion :

[dumor]

Bonjour. Voila ma demande:
Je voudrais associer une ligne à la valeur de la première cellule de cette ligne qui comporte un réfezrence sur laquelle je voudrais influer pour effectuer des tris d'ordre croissant et insertion dans un autre tableau) sans qu'il y ai d'"interférences"
Merci

[Pierre Fauconnier]

Bonjour

En effet, même après le coup de marteau, je n'ai rien compris

Peut-être faudrait-il que tu expliques différemment quelles sont tes données de départ et ce que tu souhaites réaliser...

[dumor]

Bonsoir,

A partir de deux feuilles différentes nommées 1:Criteres et 2:Extraction je veux en créer une seule 3 qui s'appelle agglomération.
Les feuilles 1 et 2 ont une colonne (colonne A pour les deux) qui ont le même champ mais des références se trouvent en doublon dans les deux feuilles.
Le but est de copier ces reference dans la mêeme feuille : Agglomération et de coller les lignes des feuilles criteres et extraction qui correspondent à la référence de la premiere colonne (peut être en utilisant .value).
Voici le code que j'ai commencé à ecrire.
Je le trouve assez hasardeuxet qui bien sur ne fonctionne pas.

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
 
Sub Agglo()
 
'On sélectionne la colonne DI du document sur les critéres
Windows("indicateur_fuites.xls").Activate
 
Dim Cell As Range
Dim Ligne1 As Integer
Dim Ligne2 As Integer
Dim Ligne3 As Integer
Dim DIcriteres As Range
Dim DIextraction As Range
Dim Cellule As Range
Dim i, j, k, l, m, n As Integer
 
'On sélectionne la colonne DI du document Criteres
Sheets("Criteres").Select
Ligne1 = Worksheets("Criteres").UsedRange.Rows.Count
 
Range(A3, ALigne1) = DIcriteres
 
'On sélectionne la colonne DI du document extraction
Sheets("Extraction").Select
Ligne2 = Worksheets("Extraction").UsedRange.Rows.Count
 
 
Range(A2, ALigne2) = DIextraction
 
 
'on attache les lignes pour la feuille criteres   :(
For i = 1 To ligne
Set Sheets("Criteres").Range("A3:ALigne1").Row(k) = linecri
i = i + 1
Next
 
'on attache les lignes pour la feuille extraction   :(
For j = 1 To ligne
Set Sheets("Extraction").Range("A2:ALigne2").Row(l) = lineext
j = j + 1
Next
 
'on copie la colonne des numéro de DI  du fichier criteres
Worksheets("Criteres").Activate
DIcriteres.Copy
 
'on les colles dans la feuille agglomération
Worksheets("Agglomeration").Activate
ActiveSheet.Paste Destination:=Sheets("Agglomeration").Range("A3:ALigne1")
 
'on copie la colonne des numéro de DI  du fichier criteres
Worksheets("Extraction").Activate
DIextraction.Copy
 
'on les colles dans la feuille agglomération a la suite des référence de Criteres
Worksheets("Agglomeration").Activate
ActiveSheet.Paste Destination:=Sheets("Agglomeration").Range("ALigne1 +1:ALigne1+Ligne2")
 
'On enleve les doublons
Worksheets("Agglomeration").Column(A).Removeduplicates
 
'On va trier ces références dans l'ordre croissant
ActiveSheet.Unprotect ("Agglomeration")
     Range("A2:V4000").Sort Key1:=Range("V2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
With Range(Range("A2"), Range("V4000").End(xlUp))
    .Sort Key1:=Range("V2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End With
        ActiveSheet.Protect ("Agglomeration")
        Range("A1").Select
 
'On définit alors le nombre de lignes qu'il y a dans le document agglomération
Ligne1 = Worksheets("Agglomeration").UsedRange.Rows.Count
 
'On colle les bouts de ligne qui vont avec
For k = 1 To Ligne3
If Cell(j, 1) = DIcritere.Value Then Sheets("Agglomeration").Range("N1;Wi").Row(i) = linecri.Value
End If
k = k + 1
Next
 
For l = 1 To Ligne3
If Cell(j, 1) = DIextraction.Value Then Sheets("Agglomeration").Range("N1;Wi").Row(i) = lineext.Value
End If
l = l + 1
Next
 
'on met les lignes avec du vides en couleur
 
For m = 1 To 21
For n = 1 To Ligne3
If Cell(i, j) = "" Then Cell(i, j).Interior.ColorIndex = 5
 
'On fait le retour ver la feuille critere si des cellules n'ont pas été complétées
Worksheets("Agglomeration").Activate
For m = 1 To Ligne3
If Cell(m, 14) = "" Then Sheets("Extraction").Range("A2:VLigne3").Row(m).Copy
ElseIf Cell(m, 14) = "" Then Sheets("Extraction").Range("A2:VLigne3").Row(m).Copy
Else
End If
m = m + 1
n = n + 1
Next
Next
 
Worksheets("Criteres").Activate
ActiveSheet.Paste Destination:=Sheets("Criteres") 'comment definir qu'il faut mettre ces lignes à la fin?
 
'la feuille agglomération s'incémentera lorsque l'on lancera de nouveau le module
 
 
End Sub

J'espere que j'ai été clair et que vous pourriez m'aidez .

Merci

[Pierre Fauconnier]

...et de coller les lignes des feuilles criteres et extraction qui correspondent à la référence de la premiere colonne...

Je n'ai pas compris.

Il serait judicieux de mettre une image de tes trois feuilles, que l'on puisse se faire une idée de l'agencement de ton classeur.

Laisse tomber ton code pour le moment, il y a trop de problèmes de syntaxe. On y reviendra par la suite

[dumor]

En fait je suis sur une nouvelle piste et je vais utiliser la fonction recherchev par contre je cherche dans un tableau d'une autre feuille nommée critére et lorsque j'écris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

cell(i,14)= Recherchev(cell(i,1);Critere($B$3:$i$Ligne1);2)

Ca ne fonctionne pas c'est surement avec la référence à la feuille critere qu'il y a un pb

[Pierre Fauconnier]

Si tu veux "saisir" en vba une formule dans une cellule, tu dois passer la formule en anglais à la propriété Formula de la cellule

Voici un code d'exemple...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

cells(1,4)="=VLOOKUP(C1,A2:A10,3)"

qui attribue à D1 la formule excel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=RECHERCHEV(C1;A2:A10;3)

Attention que du dois évidemment passer une chaîne valide.

En procédant ainsi, tu ne dois pas boucler sur les cellules pour saisir la formule dans chaque cellule, tu peux faire un copier coller par vba (voir cette discussion ou je conseille la même chose, avec une autre formule)

[dumor]

Merci
Ce filon m'apermi de rapidement progresser et d'obtenir un code a peu près convenable malheureusement il y a ne fonctionne pas : bug au niveau de ligne avec le smiley

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Sub Agglo()
 
'On sélectionne la colonne DI du document sur les critéres
Windows("indicateur_fuites.xls").Activate
 
Dim Cell As Range
Dim Ligne1 As Integer
Dim Ligne2 As Integer
Dim debtab As Range
Dim fintab As Range
Dim finext As Range
Dim finagg As Range
Dim fina As Range
Dim fincri As Range
Dim tabcriteres As Range
Dim i As Integer
 
'On sélectionne la colonne DI du document extraction
Worksheets("Critere").Activate:(
Ligne1 = Worksheets("Critere").UsedRange.Rows.Count
 
Worksheets("Extraction").Activate
Ligne2 = Worksheets("Extraction").UsedRange.Rows.Count
finext = Worksheets("Extraction").Cell(Ligne2, 13)
 
Range(A2, finext).Copy
 
'On colle dans la feuille Agglomération
finagg = Worksheets("Agglomeration").Cell(Ligne2 + 1, 13)
ActiveSheet.Paste Destination:=Sheets("Agglomeration").Range("A3:finagg")
 
'On compare les DI et on colle les informations à la suite
debtab = Worksheets("Critere").Cells(1, 1)
fintab = Worksheets("Critere").Cells(Ligne1, 10)
tabcriteres = Worksheets("Critere").Range(debtab, fintab)
 
For i = 2 To Ligne2
Cell(i, 14) = "=VLOOKUP(Cell(i,1),tabcriteres,2)" 'Gravité
Cell(i, 15) = "=VLOOKUP(Cell(i,1),tabcriteres,3)" 'Catégorie
Cell(i, 16) = "=VLOOKUP(Cell(i,1),tabcriteres,4)" 'Priorisation
Cell(i, 17) = "=VLOOKUP(Cell(i,1),tabcriteres,5)" 'Poids
Cell(i, 18) = "=VLOOKUP(Cell(i,1),tabcriteres,6)" 'Age
Cell(i, 19) = "=VLOOKUP(Cell(i,1),tabcriteres,7)" 'Poids des ans
Cell(i, 20) = "=VLOOKUP(Cell(i,1),tabcriteres,8)" 'Score
Cell(i, 21) = "=VLOOKUP(Cell(i,1),tabcriteres,9)" 'Prévue le
i = i + 1
Next
 
'On copie les colonnes pour les remettre dans la feuille critére
Worksheets("Agglomeration").Column(A).Copy
Worksheets("Criteres").Activate
ActiveSheet.Paste Destination:=Sheets("Criteres").Column(A)
 
 
fina = Worksheets("Agglomeration").Cell(Ligne2, 21)
Worksheets("Agglomeration").Range(N1, fina).Copy
Worksheets("Criteres").Activate
fincri = Worksheets("Criteres").Cell(Ligne2, 9)
ActiveSheet.Paste Destination:=Sheets("Criteres").Range(B1, fincri)
 
 
'Titre des colonnes du document d'agglomération
Worksheets("Agglomeration").Activate
 
Cells(1, 1) = "N°DI"
Cells(1, 2) = "N°Tranche"
Cells(1, 3) = "Système"
Cells(1, 4) = "N° PF"
Cells(1, 5) = "Bigramme"
Cells(1, 6) = "Libellé"
Cells(1, 7) = "AT/TEF"
Cells(1, 8) = "Arrêt?"
Cells(1, 9) = "Priorité"
Cells(1, 10) = "Etat"
Cells(1, 11) = "Date dernière MAJ"
Cells(1, 12) = "Date émission"
Cells(1, 13) = "Date prévue"
Cells(1, 14) = "Gravité"
Cells(1, 15) = "Catégorie"
Cells(1, 16) = "Priorisation"
Cells(1, 17) = "Poids"
Cells(1, 18) = "Age"
Cells(1, 19) = "Poids des ans"
Cells(1, 20) = "Score"
Cells(1, 21) = "prévue le"
 
'Dimensionnement des cellules
 
Columns(1).AutoFit
Columns(2).AutoFit
Columns(3).AutoFit
Columns(4).AutoFit
Columns(5).AutoFit
Columns(6).AutoFit
Columns(7).AutoFit
Columns(8).AutoFit
Columns(9).AutoFit
Columns(10).AutoFit
Columns(11).AutoFit
Columns(12).AutoFit
Columns(13).AutoFit
Columns(14).AutoFit
Columns(15).AutoFit
Columns(16).AutoFit
Columns(17).AutoFit
Columns(18).AutoFit
Columns(19).AutoFit
Columns(20).AutoFit
Columns(21).AutoFit
 
 
End Sub

Pouvez vous m'indiquez pourquoi et n'hesitez pas à me faire des remarques sur les fautes de syntaxe
Sinon meme si je suis novice je pense que la trame du code est bonne
Merci

[Pierre Fauconnier]

Je détecte un problème ici (et dans les lignes qui suivent...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cell(i, 14) = "=VLOOKUP(Cell(i,1),tabcriteres,2)"

Tu dois recréer la chaîne pour qu'elle soit interprétable par excel, qui ne connait ni la variable i, ni la plage tabcriteres. De plus, comme je le disais, tu n'as pas besoin de boucler, tu peux placer la formule sur la première ligne, puis copier-coller.

Cela donnerait, en supprimant donc la boucle sur i

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cell(2, 14) = "=VLOOKUP(a2," & tabcriteres.address & ",2)"

Tu adaptes les lignes suivantes pour décaler la colonne dans la formule, puis tu colles

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

range("n2:u2").copy destination:=range("n3:n" & ligne)

Si je peux me permettre une autre conseil, découpe ton code en petites procédures simples, rapides à lire, à comprendre, à débuguer et à adapter. Tu auras un code beaucoup plus digeste
Exemple:
Une procédure pour copier
une procédure pour placer la formule et la copier
une procédure pour trier
...

Puis, au sein d'une procédure globale, tu enchaînes les appels aux procédures particulières.

[dumor]

Bonjour,

En fait je n’ai pas très bien compris le fonctionnement avec copier coller.
Le probleme c’est que je dois coller dans une autre feuille que celle ou je cherche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Cell(2, 14) = "=VLOOKUP(a2," & tabcriteres.Address & ",2)" 'Gravité
Cell(2, 15) = "=VLOOKUP(a2," & tabcriteres.Address & ",3)" 'Catégorie
Cell(2, 16) = "=VLOOKUP(a2," & tabcriteres.Address & ",4)" 'Priorisation
Cell(2, 17) = "=VLOOKUP(a2," & tabcriteres.Address & ",5)" 'Poids
Cell(2, 18) = "=VLOOKUP(a2," & tabcriteres.Address & ",6)" 'Age
Cell(2, 19) = "=VLOOKUP(a2," & tabcriteres.Address & ",7)" 'Poids des ans
Cell(2, 20) = "=VLOOKUP(a2," & tabcriteres.Address & ",8)" 'Score
Cell(2, 21) = "=VLOOKUP(a2," & tabcriteres.Address & ",9)" 'Prévue le
 
Range("n2:u2").Copy Destination:=Range("n3:n" & ligne)

En fait c'est la derniere ligne qui me pose pb