VBA: transfert de données entre colonnes Fermé

Question

Bonjour à tous,

Débutant en VBA, je cherche à faire une macro qui, en fonction des données d'une colonne, extrait les données d'une autre colonne dans une 3ème...

Exemple:
A	B		

0	 2000
G	 3400
G       3700
H       200
H       1500
H       1300
G       1400

Je voudrais faire apparaitre en colonne C, pour chaque "groupement" H ou G, le maximum de B de celui-ci (ex: le max pour A2:A3 est 3700 (en B). Je voudrais que 3700 apparaisse en C2 et C3. Le max de A4:A6 est 1500. Je voudrais que 1500 apparaisse en C4:C6)

J'ai commencé à faire un code tout seul à partir de ce que j'ai pu trouver à droite à gauche, mais j'imagine que ça doit pas être glorieux:

 Sub Test1()
  Dim i, j As Integer
     i = 2
     For j = 1 To 10 'beaucoup plus de lignes en réalité...
        While Range("F" & i).Value = Range("F" & i - 1).Value
        i = i + 1
        Wend
        Range("J&i:J&j").Value = Application.WorksheetFunction.Max(Range("I&i:I&j").Value)
        Next j
 End Sub


Merci de vos réponses!
Configuration: Windows XP / Firefox 3.5.9

dct33 · Answer

Bonsoir,

J'ai mis vos données colonne 1 et 2 à partir de la ligne 1
Je vous ai fait un truc vite fait, je suis parti du principe que le nombre de critères n'est pas connu (O G H et d'autres)

Sub Macro1()

Dim Tableau_Critère() As String
Dim Tableau_Critère2() As String
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
X = 1
' chargement de tous les critères dans un tableau Tableau_Critère
While Cells(X, 1) <> ""
ReDim Preserve Tableau_Critère(X) As String
Tableau_Critère(X) = Cells(X, 1)
X = X + 1
Wend

ReDim Preserve Tableau_Critère2(1) As String
Tableau_Critère2(1) = Tableau_Critère(1)

' récupération dans un tableau des différents critères Tableau_Critère2
For Y = 1 To UBound(Tableau_Critère)

existe = 0
For Z = 1 To UBound(Tableau_Critère2)
If Tableau_Critère(Y) = Tableau_Critère2(Z) Then
existe = 1
Exit For
End If

Next Z
If existe = 0 Then
ReDim Preserve Tableau_Critère2(UBound(Tableau_Critère2) + 1) As String
Tableau_Critère2(UBound(Tableau_Critère2)) = Tableau_Critère(Y)
End If

Next Y

' recherche du max pour chaque critère

For X = 1 To UBound(Tableau_Critère2)
Max = 0
Y = 1
While Cells(Y, 1) <> ""
If Cells(Y, 1) = Tableau_Critère2(X) Then
If Cells(Y, 2) > Max Then Max = Cells(Y, 2)
End If

Y = Y + 1
Wend
' ecriture sur la feuille
Cells(X, 3) = Tableau_Critère2(X)
Cells(X, 4) = Max
Next X

End Sub

Comme toujours en programmation il y a plusieurs façons de voir
en voilà une

Bonne programmation

Elmo · Answer

Bonjour,

Tout d'abord, merci pour votre réponse, même si je n'ai pas tout compris!

En fait, l'objectif ici n'est pas de déterminer le max pour chaque critère mais par "groupement de critère" et par ligne.

Je m'explique: si en ligne 2 et 3 on a H et H, je voudrait qu'en colonne C s'affiche, pour les lignes 2 et 3, le maximum de ces 2 lignes.

Pour reprendre mon 1er exemple, le résultat serait ceci:

0 2000 2000
G 3400 3700
G 3700 3700
H 200 1500
H 1500 1500
H 1300 1500
G 1400 1400

Plus précisément, il n'y a que 2 critères, H et G. Pour les 0, il n'y a rien à faire, juste recopier la valeur de la colonne B en C.

Pour placer le contexte: j'ai un fichier client. J'ai regroupé certains clients en fonction de leurs appartenance à un groupe plus grand. H et G sont là pour dire "ce client appartient au même groupe que les H (ou G) adjacents. Les "0" sont des clients qui n'appartiennent pas à un groupe particulier

Encore merci.

dct33 · Answer

Bonjour,
Au vu du petit tableau ceci doit s'approcher
J'ai fait débuter mon tableau en A2

Vous pouvez tout copier à partir du Sub Macro1() les explications à l'intérieur
sont en commentaire

Sub Macro1()
X = 2 ' mettre le numéro de ligne où débute votre tableau

Max = 0 ' Variable qui contient le Max
Debut_Groupe = X 'debut de la zone pour un critère

While Cells(X, 1) <> ""
If Cells(X, 2) > Max Then
Max = Cells(X, 2) ' recup du max pour un groupement

End If

If Cells(X + 1, 1) <> Cells(X, 1) Then
For Y = Debut_Groupe To X
Cells(Y, 3) = Max ' remplissage en colonne 3 du max pour un groupement
Next Y
Max = 0
Debut_Groupe = X + 1

End If
X = X + 1
Wend

End Sub

Bonne continuation

Elmo · Answer

Merci beaucoup, ça marche très bien!

VBA: transfert de données entre colonnes

4 réponses

Discussions similaires

Newsletters