Macro conversion de données

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

doudou76

XLDnaute Nouveau
Bonjour à tous

Je suis nouveau sur le forum, débutant en visual basic (et sans doute un peu allergique).

Je dois réaliser une macro pour transférer des données d'un fichier Excel à un autre. (Excel 2003)
Les données que je dois transférer sont du type vrai/faux, elles correspondent aux réponses concernant des critères sur des sites différents. (5 critères, 6 sites)
Pour simplifier, mon tableau Excel dans le fichier1, feuille1 se présente comme ceci :

crit1 / crit2/ crit3 /crit4/ crit5
FAUX / FAUX/ FAUX/ VRAI/ VRAI/ site n°1
FAUX/ FAUX/ FAUX/ VRAI/ VRAI / site n°2
FAUX/ FAUX/ FAUX/ VRAI/ VRAI / site n°3
FAUX/ VRAI/ FAUX/ VRAI/ VRAI / site n°4
FAUX/ FAUX/ FAUX/ FAUX/ VRAI / site n°5
FAUX/ FAUX/ FAUX/ FAUX/ FAUX / site n°6

Je dois transférer le tout par macro dans le fichier2, feuille2 (les deux fichiers possèdent plusieurs onglets).
Dès qu'un critère est "vrai", seul le numéro du critère est retenu pour le site considéré.
Le résultat doit donc s'afficher comme suit:

n°site / n°crit
1 / 4
1 / 5
2 / 4
2 /5
idem pour le site n°3
4 /2
4 /4
4 /5
5 / 5

Pour résumer, on passe donc du texte booléen au numérique.
D'une présentation des données horizontale à verticale.
Les données "faux" ne seront pas conservées.

J'imagine qu'il faut procéder par étape.
Cela fait plusieurs jours que cherche un cas qui pourrait ressembler au mien sur les forums, les tutoriels mais rien n'y fait je tourne en rond. Tout ce que j'ai pu essayer ne marche pas.

Voilà ce que j'ai réussi de plus convainquant, mais je vous rassure ça ne donne rien!!

Sub Macro11()
For Each c In Worksheets("T_delimite_critere").Range("G6:K11")
If char = "VRAI" Then
If Column.Value = "G" Then
Cells.Value = 1
ElseIf Column.Value = "H" Then
Cells.Value = 2
ElseIf Column.Value = "I" Then
Cells.Value = 3
ElseIf Column.Value = "J" Then
Cells.Value = 4
ElseIf Column.Value = "K" Then
Cells.Value = 5
End If
End If
Next c
End Sub

Il y a sûrement quelqu'un pour qui cela est un jeu d'enfant, alors tenez moi au courant.
Je vous remercie par avance pour le temps que vous allez consacrer à étudier mon problème.

A bientôt.
 
Re : Macro conversion de données

Bonjour Doudou, bonjour le forum,

peut-être comme ça mais je suis pas sûr d'avoir bien compris... :
Code:
Sub Macro11()
For Each c In Worksheets("T_delimite_critere").Range("G6:K11")
     If c.Value = True Then
        Select Case c.Column
            Case 7
            c.Value = 1
            Case 8
            c.Value = 2
            Case 9
            c.Value = 3
            Case 10
            c.Value = 4
            Case 11
            c.Value = 5
        End Select
    Else
        c.Value = ""
    End If
Next c
End Sub

Un petit fichier exemple en pièce jointe serait plus explicite...
 
Re : Macro conversion de données

Tu as parfaitement compris Robert, ton code fonctionne.
Un grand merci.

La première étape est réussie, maintenant il reste à transférer tout ça dans le 2éme fichier. Voir le fichier joint pour la présentation des résultats dans le fchier2.

Le tout doit tenir dans une seule macro.

Merci et A+
 

Pièces jointes

Re : Macro conversion de données

Bonjour Doudou, bonjour le forum,

Je te propose la macro ci-dessous que tu adapteras (au niveau du nom des fichiers et du nom des onglets). Pour quelle fonctionne il faut que les deux fichiers (Origine et Source) soient ouverts. Le fichier Origine n'est plus modifié comme dans la première macro. J'espère que ça ne te pose pas de problème...
Code:
Sub Macro1()
Dim o As Workbook 'déclare la variable o (classeur d'Origine)
Dim c As Workbook 'déclare la variable c (classeur Cible)
Dim x As Byte 'déclare la variable x
Dim y As Byte 'déclare la variable y
 
Set o = Workbooks("origine.xls") 'définit la variable o (à adapter à ton cas)
Set c = Workbooks("cible.xls") 'définit la variable c (à adapter à ton cas)
c.Sheets("Feuil2").Range("A5").CurrentRegion.Clear 'efface les anciennes valeurs
c.Sheets("Feuil2").Range("A5").Value = "Nº Site" 'étiquette en A5
c.Sheets("Feuil2").Range("B5").Value = "Nº Critère" 'étiquette en B5
 
With o.Sheets("T_delimite_critere") 'prend en compte l'onglet "T_delimite_critere" (à adapter à ton cas)
    For x = 1 To 6 'boucle 1 : sur les 6 lignes de "numéro de site"
        For y = 1 To 5 'boucle : 2 sur les 5 colonnes de "critère"
            If .Cells(x + 5, y + 6) = True Then 'condition : si la cellule est "VRAI"
                c.Sheets("Feuil2").Cells(65536, 1).End(xlUp).Offset(1, 0).Value = x 'place le numéro de site en colonne A
                c.Sheets("Feuil2").Cells(65536, 2).End(xlUp).Offset(1, 0).Value = y 'place le numéro de critère en colonne B
            End If 'fin de la condition
        Next y 'prochain critère de la boucle 2
    Next x 'prochain site de la boucle 1
End With 'fin de la prise en compte de l'onglet "T_delimite_critere"
End Sub
 
Re : Macro conversion de données

Super génial, robert t'es un champion du VBA
J'ai remanié légèrement le truc mais ça marche à merveille.
Un énorme merci.

Maintenant j'ai un autre problème sans avoir l'air d'abuser.

Sur ces mêmes fichiers, je dois modifier le nom des communes correspondant à chaque site par leur numéro INSEE.
Ces numéros se trouvent dans un 3ème fichier.

Je pense que cela est largement faisable pour moi, je vais y réfléchir je te tiens au courant.

Salut et encore merci.
 
Re : Macro conversion de données

Bonjour

j'ai réussi la macro sur les communes et a peu près toutes celles que je devais faire. Par contre certaines sont un peu lourdes, le PC rame quand les boucles sont un peu longues.

Je dois maintenant rassembler toutes ces macros sous une seule pour que ce soit plus pratique. Je ne sais pas trop comment faire, je n'ai pas encore eu le temps de chercher. Si quelqu'un a un tuyaux là dessus, je suis preneur.

Merci.

A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
649
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Retour