macro excel pour un debutant

chocolat100

6 Mars 2005 20:49:09

bonjour, je cherche à fusionner des lignes excels en fonction d'une clé qui est dans la colonne A. J'ai fait un algorythme qui part du principe d'une double boucle toute simple, mais je ne connais absolument rien en VSB pour pouvoir le traduire.
Ca donne quelquechose comme ça:

Citation :

pour variable(a)=2 to 5000
variable(ah)=0
variable(ai)=0
variable(ao)=0
si case(Hvariable(a))<>vide alors variable(ah)=1
si case(Ivariable(a))<>vide alors variable(ai)=1
si case(Ovariable(a))<>vide alors variable(ao)=1

pour variable(b)=variable(a)+1 to 5000
variable(bh)=0
variable(bi)=0
variable(bo)=0
si case(A-variable(a)) = case(Avariable(b)) alors si case(Hvariable(b))<>vide alors variable(bh)=1
si case(Ivariable(b))<>vide alors variable(bi)=1
si case(Ovariable(b))<>vide alors variable(bo)=1

si variable (ah)=0 et si variable(bh)=1 alors copier(cases Gvariable(b);cases Hvariable(b)) et les coller dans (cases Gvariable(a);cases Hvariable(a))
cases GàHvariable(b)="DEPLACE"

si variable(ai)=0 et si variable(bi)=1 alors copier(cases IàNvariable(b)) et les coller dans (cases IàNvariable(a))
cases IàNvariable(b)="DEPLACE"

si variable(ao)=0 et si variable(bo)=1 alors copier(cases OàVvariable(b)) et les coller dans (cases OàVvariable(a))
cases OàVvariable(b)="DEPLACE"

variableb=variableb+1

variable a=a+1

bon, je sais, c'est peut etre pas tres compehensible, mais je suis pas un pro, loin de là.
alors si quelqu'un peut me dire comment faire pour rendre cette "macro" comprehensible en language visual basic pour excel.
Par avance, merci.

Autres pages sur : macro excel debutant

| Etre averti des réponses
| Alerter

Répondre à chocolat100

chocolat100

10 Mars 2005 00:22:58

Je cherche à comparer des lignes d'une feuille excel.
Chaque ligne va de la case A à la case V.
La case A est la concataination des cases BàF, possede une valeur pour toutes les lignes.
Pour chaque ligne, soit il y a des valaur danss les cases G et H, soit dans les cases IJKLMN, soit dans les cases OPQRSTUV.
Je veux regrouper toutes ces données sur une même ligne pour une même valeur de la colonne A, mais il y a des exception, une valeur de la colonne A peut correspondre à une ou plusieurs lignes, jusqu'a six, et il ne faut pas perdre de données.

La feuille comporte 5000 lignes

J'ai fait un algorythme qui part du principe d'une double boucle toute simple.
La premiere boucle va de la premiere ligne à la derniere ligne de la feuille
La deuxieme boucle compare la premiere ligne avec les lignes suivantes de la feuille

Si les cases H de la 1ere ligne est vide et que la case H de la deuxieme ligne ne l'est pas alors je deplace les cases G et H de la deuxieme ligne à la premier et je note "deplacé" dans les cases G et H de la deuxieme pour garder une trace du deplacement.
De même je compare les cases I entre elles pour deplacer les cases IJKLMN de la deuxieme ligne à la premiere.
Les cases O pour les cases OPQRSTUV

Après je ferai un tri tout bête pour reperer les erreures et effacer tous les "deplacé" qui sont dans les cases GàV, mais ce sera une autre histoire (ça je sais faire)

Pour aider à la lecture de mon algorythme, voici mes abreviations
<> different de
variable(a) le nom d'une variable
case(Avariable(a)) case A2 si variable(a)=2

J'espere être une peu plus clair.
Merci.

| Alerter

Répondre à chocolat100

galopin01

10 Mars 2005 09:54:47

Bonjour,
La macro suivante fait ce regroupement

Option Base 1

Sub Test()

Dim Tablo(22), iNbCol%, iLastR%, i%, j%, x%, vReq, iTrouv%

Application.ScreenUpdating = False

iNbCol = 22

iLastR = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row

For i = 1 To iLastR

  For x = 1 To 22

  Tablo(x) = Cells(i, x).Value

  Next

Set vReq = Range("A" & i & ":A" & iLastR).Find(Tablo(1))

  If Not vReq Is Nothing Then

    Do

    iTrouv = vReq.Row

    For j = 1 To 22

       With Cells(iTrouv, j)

        If Tablo(j) = .Value Then

          If j <> 1 Then

            If .Value <> "" Then

            .Interior.ColorIndex = 8

            .Value = ""

            End If

          End If

        ElseIf Tablo(j) = "" And .Value <> "" Then

        Tablo(j) = .Value

        .Interior.ColorIndex = 8

        .Value = ""

        ElseIf Tablo(j) <> "" And Tablo(j) <> .Value Then

        If .Value <> "" Then .Interior.ColorIndex = 3

        End If

        Cells(i, j).Value = Tablo(j)

     End With

     Next

    Set vReq = Range("A" & i & ":A" & iLastR).FindNext(vReq)

    iTrouv = vReq.Row

    Loop While Not vReq Is Nothing And iTrouv <> i

  End If

Next

End Sub

Les déplacements sont colorés en bleus
Les erreurs en rouge.
Prévoir ...un peu de patience !
Ok ?

| Alerter

Répondre à galopin01