Besoin d'aide en VBA Excel Concatener + déplacement de donnée

Besoin d'aide en VBA Excel Concatener + déplacement de donnée - VB/VBA/VBS - Programmation

Marsh Posté le 30-09-2017 à 18:05:33    

Bonjour

 

Voilà j'essaie de faire une macro permettant de concaténer des valeurs sur une ligne et de mettre en forme un tableau en fonction de paramètres situées sur la même ligne.

 

J'ai atteint ici mes limites dans le copier/coller de code trouvé sur le net et de quelques lignes faites par déductions. Donc si vous pensez pouvoir apporter juste un petit bout de code, conseil ou correction n'hésiter pas, je ne vous demande pas de tout me fournir clef en mains mais, de m'aider pour avancer.

 

J'ai fait (En partie) la première partie : ouvrir la feuille, Créer un nouvelle onglet "ES" concaténer les cellules et coller la désignation à côté.
Voici le lien qui va bien: https://we.tl/vhaSg8vaSB

 

Pour résumer, (J'ai supprimé un grand nombre de colonnes pour simplifier et ne garder que l'essentiel)
Sur une même ligne j’aurai :

 

- Les cellules à concaténer (réf de l'élément)
- la désignation
- la validation de la ligne dans la catégorie "lot électrique"
- la présence d'un sectionneur de proximité ou non "IS"
- la présence d'un variateur de vitesse ou non
- la présence d'un démarreur ou non
- le nombre d'entrée Tor
- le nombre de sortie Tor
- le nombre d'entrée analogique
- le nombre de sortie analogiques
- le nombre d'entrées rtd

 

Ce qu’il reste à faire :

 

- Ajouter le jour est l'heure au nom de l'onglet pour éviter les bugs en cas d'exécutions multiple de la macro (pas primordial).

 

- le nombre de colonnes pouvant varier, il faudrait leur donner une position relative.
En début d'exécution je cherche les colonnes qui m'intéresses et je note leurs position dans une variable qui sera utilisée ensuite. (La manœuvre pouvant être faite manuellement en complétant les cases de l'onglet "Macro" si c'est trop compliqué (j'ai pas réussi, il en reste des traces dans la macro).

 

- Ne concaténer que les cellules ayant sur la même ligne un "O" dans la colonne "lot-électrique" et s'arrêter à la dernière ligne non vide du tableau (pas la première ligne vide rencontrée....).

 

- Créer sous chaque lignes concaténée un tableau comprenant les nombres de cellules indiqué dans les paramètres de nombre d'entrée/sortie (voir exemple dans Macro LEQ.xlsm dans l'onglet "Forme Tableau" )
Ne pas créer de tableau si case vide ou égale à 0

 

Je pense que c'est tout dans un premier temps.
Cette macro a principalement pour but de simplifier un travail de recopie en évitant les erreurs et oubli.
Une fois les tableau dimensionnés je n'ai plus qu'à les compléter ou à les réagencer en fonction de mes besoins.

 

Merci d'avance pour votre aide.

 

Valery


Message édité par valerypetit le 30-09-2017 à 19:14:34

---------------
Il y a deux choses d'infini au monde : l'univers et la bêtise humaine... mais pour l'univers j'en suis pas très sûr
Reply

Marsh Posté le 30-09-2017 à 18:05:33   

Reply

Marsh Posté le 04-10-2017 à 17:08:53    

Bonjour,
 
Pas beaucoup de réponses....  
je pense avoir donnée trop de détail, désolé de vous avoir fais peur.....
 
je m'en suis sortie en faisant des copier/coller sur internet.
quelques seconde d’exécution, il est probable que ça ne soit pas optimisé.
si vous avez des conseilles n'hésitez pas.
 

Code :
  1. '
  2. ' Attention s'assurer qu'aucune cellule ne soit cachée
  3. '
  4. Sub OuvrirFichier()
  5. 'On reléve les positions des colonnes
  6.     Dim rRepère As Range
  7.     Dim strRepère As String
  8.     Dim rFinCourse As Range
  9.     Dim strFinCourse As String
  10.     Dim rVarFreq As Range
  11.     Dim strVarFreq As String
  12.     Dim rLot_Élec As Range
  13.     Dim strLot_Élec As String
  14.     Dim rIS As Range
  15.     Dim strIS As String
  16.     Dim rETor As Range
  17.     Dim strETor As String
  18.     Dim rSTor As Range
  19.     Dim strSTor As String
  20.     Dim rEAna As Range
  21.     Dim strEAna As String
  22.     Dim rSAna As Range
  23.     Dim strSAna As String
  24.     Dim rERTD As Range
  25.     Dim strERTD As String
  26.    
  27.     Dim objNomFichier As Range, PlageDeRecherche As Range
  28.     Dim NomFichier As String, strNomFichier As String
  29.    
  30.     Dim i As Long, j As Long
  31.     j = 2
  32. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  33. ' On ouvre le fichier dont le nom est présent dans la cellule C5
  34.     Set objNomFichier = Range("C5" )
  35.     strNomFichier = ActiveWorkbook.FullName
  36.     strNomFichier = Left(strNomFichier, InStrRev(strNomFichier, "\" ))
  37.     NomFichier = strNomFichier & "\" & objNomFichier.Value
  38.     Workbooks.Open (NomFichier)
  39.     Set objNomFichier = Nothing
  40.    
  41. ' On crée l'onglet "ES"
  42. Dim strNomOnglet As String, AdresseTrouvee As String
  44. 'Jour = Day(Now)
  45. 'Heure = Hour(Now)
  46. 'strNomOnglet = "ES" & Jour & Heure
  47.     Sheets.Add After:=ActiveSheet
  48.     ActiveSheet.Name = "ES"
  49.    
  50. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  51. ' on essai de trouver les mots voulu dans la ligne 6 de la feuille "LEQ"
  52.    Sheets("LEQ" ).Select
  53.   'Set PlageDeRecherche = Sheets(LEQ).Range("A6:Az6" )
  54.  
  55.     Set rRepère = Range("A5:BZ6" ).Find("Repère" )
  56.     strRepère = Split(Columns(rRepère.Offset(0, 1).Column).Address(ColumnAbsolute:=False), ":" )(1)
  57.  
  58. '   strFinCourse = Range("C11" )
  60.     Set rLot_Élec = Range("A5:BZ6" ).Find("Lot Élec (O/N)" )
  61.     strLot_Élec = Split(Columns(rLot_Élec.Column).Address(ColumnAbsolute:=False), ":" )(1)
  62.  
  63.     Set rETor = Range("A5:BZ6" ).Find("E TOR" )
  64.     strETor = Split(Columns(rETor.Column).Address(ColumnAbsolute:=False), ":" )(1)
  66.     Set rSTor = Range("A5:BZ6" ).Find("S TOR" )
  67.     strSTor = Split(Columns(rSTor.Column).Address(ColumnAbsolute:=False), ":" )(1)
  69.     Set rEAna = Range("A5:BZ6" ).Find("E ANA" )
  70.     strEAna = Split(Columns(rEAna.Column).Address(ColumnAbsolute:=False), ":" )(1)
  72.     Set rSAna = Range("A5:BZ6" ).Find("S ANA" )
  73.     strSAna = Split(Columns(rSAna.Column).Address(ColumnAbsolute:=False), ":" )(1)
  75.     Set rERTD = Range("A5:BZ6" ).Find("E RTD" )
  76.     strERTD = Split(Columns(rERTD.Column).Address(ColumnAbsolute:=False), ":" )(1)
  78.     Set rVarFreq = Range("A5:BZ6" ).Find("Var. Fq (O/N)" )
  79.     strVarFreq = Split(Columns(rVarFreq.Column).Address(ColumnAbsolute:=False), ":" )(1)
  80.    
  81.     Set rIS = Range("A5:BZ6" ).Find("Avec retour de contact" )
  82.     strIS = Split(Columns(rIS.Column).Address(ColumnAbsolute:=False), ":" )(1)
  83.    
  84.     Range("ES!B" & j).Value = "PID"
  85.     Range("ES!C" & j).Value = "Désignation"
  86.     Range("ES!D" & j).Value = "E TOR"
  87.     Range("ES!E" & j).Value = "S TOR"
  88.     Range("ES!F" & j).Value = "E ANA"
  89.     Range("ES!G" & j).Value = "E RTD"
  90.     Range("ES!H" & j).Value = "S ANA"
  91.     Range("ES!I" & j).Value = "Var.Fq"
  92.     Range("ES!J" & j).Value = "Dém"
  93.     Range("ES!K" & j).Value = "IS"
  94.    
  96. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  97. 'On Concaténe jusqu'à la dérniére ligne non vide
  98. Nb_ligne = Range("A65536" ).End(xlUp).Row
  99. For Each c In Range("E8:E" & Nb_ligne)
  101. ' on Control la présence d'un "O" dans le Lot_Elec
  102. Ligne = c.Row
  103. 'If Range("LEQ!B" & ligne).Value = "306" Then
  104. If Range(strLot_Élec & Ligne).Value = "O" Then
  106. Concat = c.Value
  107. For i = 1 To 5
  108. Concat = Concat & c.Offset(0, i)
  109. Next
  111. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  112. j = j + 1
  113. 'On Copie dans la feuille ES
  114. Range("ES!B" & j).Value = Concat ' colonne qui affichera le resultat ( ici colonne B)
  115. Range("ES!C" & j).Value = Range("LEQ!K" & Ligne).Value  'Désignation
  116. Range("ES!D" & j).Value = Range("LEQ!AW" & Ligne).Value 'E TOR
  117. Range("ES!E" & j).Value = Range("LEQ!AX" & Ligne).Value 'S TOR
  118. Range("ES!F" & j).Value = Range("LEQ!AY" & Ligne).Value 'E Ana
  119. Range("ES!G" & j).Value = Range("LEQ!AZ" & Ligne).Value 'E RTD
  120. Range("ES!H" & j).Value = Range("LEQ!BA" & Ligne).Value 'S ANA
  121. Range("ES!I" & j).Value = Range("LEQ!AO" & Ligne).Value 'Var.Freq
  122. Range("ES!J" & j).Value = Range("LEQ!AP" & Ligne).Value 'Dém
  123. Range("ES!K" & j).Value = Range("LEQ!AU" & Ligne).Value 'IS
  124. End If
  125. Next
  127. '<<<<<<<<<<<<<<<<<<<<<< Mise en forme Tableau <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  129. Sheets("ES" ).Select
  130.     Range("B2:K2" ).Font.Bold = True
  131.     Range("B2:K2" ).HorizontalAlignment = xlCenter
  132.     Range("B2:K2" ).VerticalAlignment = xlBottom
  134. ' On supprime les espaces dans les désignation
  135.     Columns("C:C" ).Select
  136.     Selection.Replace What:=" ", Replacement:="_", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  137.    
  138.      Cells.Select
  139.     Cells.EntireColumn.AutoFit
  140.    
  141. 'On ajoute les bouton pour la macro suivante
  142.         ActiveSheet.Buttons.Add(800, 70, 100, 30).Select
  143.     Selection.OnAction = "triage_pid"
  144.     Selection.Characters.Text = "Triage PID"
  146.          ActiveSheet.Buttons.Add(800, 120, 100, 30).Select
  147.     Selection.OnAction = "Formater_Tableau"
  148.     Selection.Characters.Text = "Mise en Forme"
  149.   Range("A1" ).Select
  150. End Sub
  152. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  153. Sub triage_pid()
  155. ' On tri les PID
  156.     Dim rPlage_tri As Range
  157. Set rPlage_tri = ActiveSheet.Range("B3:K" & Range("B" & Rows.Count).End(xlUp).Row)
  158. rPlage_tri.Sort Key1:=Range("B4" ), Order1:=xlAscending, Header:=xlGuess, _
  159.         OrderCustom:=1, Orientation:=xlTopToBottom
  161. End Sub


 
le projet a beaucoup évolué et je doit maintenant créer un petit csv pour alimenter un logiciel.
beaucoup de choses à apprendre et des belles heure à me tirer les cheveux.
 
Petite question,
je voudrais déffinir une plage en fonction d'une ligne qui s'incrémente
et décaller cette plage à chaques incrémentation
 

Code :
  1. Ligne_Ecrit = Ligne_Ecrit + 1
  2. Set maplage = Range("Tableau!C"&Ligne_Ecrit&":H"&Ligne_Ecrit)


 
quelqu'un saurait corriger ma seconde ligne????
 
Merci d'avance ;-)


---------------
Il y a deux choses d'infini au monde : l'univers et la bêtise humaine... mais pour l'univers j'en suis pas très sûr
Reply

Marsh Posté le 04-10-2017 à 18:34:16    

Salut,
 
Je pense que cela doit plutôt être :
 

Code :
  1. Set maplage = Sheets("Tableau" ).Range("C"&Ligne_Ecrit&":H"&Ligne_Ecrit)

Reply

Marsh Posté le 06-10-2017 à 09:40:31    

Merci, ça fonctionne parfaitement.

 

je ne comprend pas, j'ai aussi le petit bout de code suivant:

 
Code :
  1. For Each i In Range("G3:G" & Nb_ligne)
  2.     If Range("G" & Ligne_Lect) = 1 Then
  3.    
  4.     Range("Liste ES!B" & Ligne_Ecrit).Value = Range("Tableau!H" & Ligne_Lect).Value 'E Tor
  5.     Range("Liste ES!C" & Ligne_Ecrit).Value = Range("Tableau!I" & Ligne_Lect).Value 'Mnémonique
  6.     Range("Liste ES!D" & Ligne_Ecrit).Value = Range("Tableau!D" & (Ligne_Lect)).Offset(-1, 0).Value 'PID
  8.     End If
  9.     Ligne_Lect = Ligne_Lect + 1
  10. Next
 

Qui me renvoi un défaut: "Erreur '1004' : la méthode range de l'objet _global a échoué......

 

Pourtant je l'ai utilisé plusieurs fois, y compris dans mon premier code posté et là je ne trouve pas le problème.....

 

PS : "Tableau" et "ES" sont les noms de mes feuilles. Elles sont présentes sur le même classeur.

Message cité 1 fois
Message édité par valerypetit le 06-10-2017 à 09:44:43

---------------
Il y a deux choses d'infini au monde : l'univers et la bêtise humaine... mais pour l'univers j'en suis pas très sûr
Reply

Marsh Posté le 06-10-2017 à 10:28:39    

valerypetit a écrit :

Merci, ça fonctionne parfaitement.
 
je ne comprend pas, j'ai aussi le petit bout de code suivant:
 

Code :
  1. For Each i In Range("G3:G" & Nb_ligne)
  2.     If Range("G" & Ligne_Lect) = 1 Then
  3.    
  4.     Range("Liste ES!B" & Ligne_Ecrit).Value = Range("Tableau!H" & Ligne_Lect).Value 'E Tor
  5.     Range("Liste ES!C" & Ligne_Ecrit).Value = Range("Tableau!I" & Ligne_Lect).Value 'Mnémonique
  6.     Range("Liste ES!D" & Ligne_Ecrit).Value = Range("Tableau!D" & (Ligne_Lect)).Offset(-1, 0).Value 'PID
  8.     End If
  9.     Ligne_Lect = Ligne_Lect + 1
  10. Next


 
Qui me renvoi un défaut: "Erreur '1004' : la méthode range de l'objet _global a échoué......
 
Pourtant je l'ai utilisé plusieurs fois, y compris dans mon premier code posté et là je ne trouve pas le problème.....
 
PS : "Tableau" et "ES" sont les noms de mes feuilles. Elles sont présentes sur le même classeur.


Salut !
 
Peut-être est-ce lié au fait que ta variable i est définie en tant que "long", alors que vba attend une variable "range".

Reply

Marsh Posté le 06-10-2017 à 10:38:49    

le code plus haut fonctionne et "j" est définie en tant que "long"......
 
mais j'ai effectivement:  Dim Ligne_Lect As Long, Ligne_Ecrit As Long
 
j'ai passé le Dim en commentaire pour que la variable devienne de type "Variant" mais ça ne change rien....
 
Voici le code complet.

Code :
  1. Sub Liste_ES()
  3. Dim Ligne_Lect As Long, Ligne_Ecrit As Long, Colonne_Lect As Long
  5. Ligne_Lect = 4
  6. Ligne_Ecrit = 4
  7. Colonne_Lect = 7
  9. 'Création d'un nouvel onglet
  10.     Sheets.Add After:=ActiveSheet
  11.     ActiveSheet.Name = "Liste ES"
  12.     Rows("3:3" ).Select
  13.     Selection.Font.Bold = True
  14.    
  15.     Range("3:3" ).HorizontalAlignment = xlCenter
  16.     Range("3:3" ).VerticalAlignment = xlCenter 'xlBottom
  17.    
  18. ' On définit la taille du tableau dans la page "ES"
  19.     Sheets("Tableau" ).Select
  20.     Nb_ligne = Range("D65536" ).End(xlUp).Row
  21.  
  22. ' On copie le tableau des entrées TOR
  23. For Each i In Range("G3:G" & Nb_ligne)
  24.     If Range("G" & Ligne_Lect) = 1 Then
  25.    
  26.     Range("Liste ES!B" & Ligne_Ecrit).Value = Range("Tableau!H" & Ligne_Lect).Value 'E Tor
  27.     Range("Liste ES!C" & Ligne_Ecrit).Value = Range("Tableau!I" & Ligne_Lect).Value 'Mnémonique
  28.     Range("Liste ES!D" & Ligne_Ecrit).Value = Range("Tableau!D" & (Ligne_Lect)).Offset(-1, 0).Value 'PID
  30.     End If
  31.     Ligne_Lect = Ligne_Lect + 1
  32. Next
  34. Sheets("Liste ES" ).Select
  35. End Sub


Message édité par valerypetit le 06-10-2017 à 11:01:28

---------------
Il y a deux choses d'infini au monde : l'univers et la bêtise humaine... mais pour l'univers j'en suis pas très sûr
Reply

Marsh Posté le 06-10-2017 à 13:31:22    

J'ai fait plusieurs essais, apparemment c'est la syntaxe de "Range" qui est capricieuse.
Cette ligne-ci semble fonctionner par intermittence, il semble qu'Excel l'admette, mais pas tout le temps:

Code :
  1. Range("Liste ES!B" & Ligne_Ecrit).Value


Le "bon" code est celui-ci, comme indiqué par Takama13:

Code :
  1. Worksheets("Liste ES" ).Range("B" & Ligne_Ecrit).Value


J'ai testé, j'ai bien l'erreur avec la première syntaxe et ça fonctionne avec la seconde. Ecrire le nom de la feuille dans le "Range" ne serait donc pas correct.

Message cité 1 fois
Message édité par milfeuilles le 06-10-2017 à 13:32:02
Reply

Marsh Posté le 06-10-2017 à 13:56:55    

Super, ça fonctionne.
Du coup je pense que je vais devoir refaire mes autres modules pour éviter d'avoir des aléas à l'utilisation ;-)
 
merci pour ton aide


---------------
Il y a deux choses d'infini au monde : l'univers et la bêtise humaine... mais pour l'univers j'en suis pas très sûr
Reply

Marsh Posté le 09-10-2017 à 17:49:43    

 
            Bonjour,
 
            aucun caprice mais juste le B-A-BA d'Excel !
 
            Quand il y a un espace il faut encadrer entre apostrophes, constatable dans une simple formule de feuille de calculs …
 

Message cité 1 fois
Reply

Marsh Posté le 10-10-2017 à 04:08:53    

Marc L a écrit :

 
            Bonjour,
 
            aucun caprice mais juste le B-A-BA d'Excel !
 
            Quand il y a un espace il faut encadrer entre apostrophes, constatable dans une simple formule de feuille de calculs …
 


Salut.
 
De quel espace parles-tu ?

Reply

Marsh Posté le 10-10-2017 à 04:08:53   

Reply

Marsh Posté le 10-10-2017 à 08:54:49    

milfeuilles a écrit :

J'ai fait plusieurs essais, apparemment c'est la syntaxe de "Range" qui est capricieuse.
Cette ligne-ci semble fonctionner par intermittence, il semble qu'Excel l'admette, mais pas tout le temps:

Code :
  1. Range("Liste ES!B" & Ligne_Ecrit).Value


Reply

Marsh Posté le 12-10-2017 à 10:39:09    

Et donc, quelle serait la bonne écriture pour mettre ce nom de page à l'intérieur du range ? J'avoue ne pas comprendre. Merci.

Reply

Marsh Posté le 12-10-2017 à 11:28:30    

 
            Comme indiqué, une formule de calculs utilisant la bonne syntaxe, il suffit juste d'en créer une !
 
            A la portée d'un débutant - des mômes ayant réussi à le réaliser du premier coup - juste en ouvrant un classeur avec au moins
            deux feuilles de calculs, effectuer une saisie dans une cellule.
 
            Si besoin modifier le nom de la feuille devant comporter au moins un espace.
 
            Sur l'autre feuille, commencer la formule par le signe = puis activer la feuille précédente, sélectionner la cellule saisie et valider.
            La cellule affichant donc la saisie de l'autre feuille, juste regarder la syntaxe de la formule, est-ce si compliqué ?! …
 

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed