Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
1595 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

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

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

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

n°2306227
valerypeti​t
mode initiative
Posté le 30-09-2017 à 18:05:33  profilanswer
 

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
mood
Publicité
Posté le 30-09-2017 à 18:05:33  profilanswer
 

n°2306320
valerypeti​t
mode initiative
Posté le 04-10-2017 à 17:08:53  profilanswer
 

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
  43. 'Jour = Day(Now)
  44. 'Heure = Hour(Now)
  45. 'strNomOnglet = "ES" & Jour & Heure
  46.     Sheets.Add After:=ActiveSheet
  47.     ActiveSheet.Name = "ES"
  48.    
  49. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  50. ' on essai de trouver les mots voulu dans la ligne 6 de la feuille "LEQ"
  51.    Sheets("LEQ" ).Select
  52.   'Set PlageDeRecherche = Sheets(LEQ).Range("A6:Az6" )
  53.  
  54.     Set rRepère = Range("A5:BZ6" ).Find("Repère" )
  55.     strRepère = Split(Columns(rRepère.Offset(0, 1).Column).Address(ColumnAbsolute:=False), ":" )(1)
  56.  
  57. '   strFinCourse = Range("C11" )
  58.     Set rLot_Élec = Range("A5:BZ6" ).Find("Lot Élec (O/N)" )
  59.     strLot_Élec = Split(Columns(rLot_Élec.Column).Address(ColumnAbsolute:=False), ":" )(1)
  60.  
  61.     Set rETor = Range("A5:BZ6" ).Find("E TOR" )
  62.     strETor = Split(Columns(rETor.Column).Address(ColumnAbsolute:=False), ":" )(1)
  63.     Set rSTor = Range("A5:BZ6" ).Find("S TOR" )
  64.     strSTor = Split(Columns(rSTor.Column).Address(ColumnAbsolute:=False), ":" )(1)
  65.     Set rEAna = Range("A5:BZ6" ).Find("E ANA" )
  66.     strEAna = Split(Columns(rEAna.Column).Address(ColumnAbsolute:=False), ":" )(1)
  67.     Set rSAna = Range("A5:BZ6" ).Find("S ANA" )
  68.     strSAna = Split(Columns(rSAna.Column).Address(ColumnAbsolute:=False), ":" )(1)
  69.     Set rERTD = Range("A5:BZ6" ).Find("E RTD" )
  70.     strERTD = Split(Columns(rERTD.Column).Address(ColumnAbsolute:=False), ":" )(1)
  71.     Set rVarFreq = Range("A5:BZ6" ).Find("Var. Fq (O/N)" )
  72.     strVarFreq = Split(Columns(rVarFreq.Column).Address(ColumnAbsolute:=False), ":" )(1)
  73.    
  74.     Set rIS = Range("A5:BZ6" ).Find("Avec retour de contact" )
  75.     strIS = Split(Columns(rIS.Column).Address(ColumnAbsolute:=False), ":" )(1)
  76.    
  77.     Range("ES!B" & j).Value = "PID"
  78.     Range("ES!C" & j).Value = "Désignation"
  79.     Range("ES!D" & j).Value = "E TOR"
  80.     Range("ES!E" & j).Value = "S TOR"
  81.     Range("ES!F" & j).Value = "E ANA"
  82.     Range("ES!G" & j).Value = "E RTD"
  83.     Range("ES!H" & j).Value = "S ANA"
  84.     Range("ES!I" & j).Value = "Var.Fq"
  85.     Range("ES!J" & j).Value = "Dém"
  86.     Range("ES!K" & j).Value = "IS"
  87.    
  88. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  89. 'On Concaténe jusqu'à la dérniére ligne non vide
  90. Nb_ligne = Range("A65536" ).End(xlUp).Row
  91. For Each c In Range("E8:E" & Nb_ligne)
  92. ' on Control la présence d'un "O" dans le Lot_Elec
  93. Ligne = c.Row
  94. 'If Range("LEQ!B" & ligne).Value = "306" Then
  95. If Range(strLot_Élec & Ligne).Value = "O" Then
  96. Concat = c.Value
  97. For i = 1 To 5
  98. Concat = Concat & c.Offset(0, i)
  99. Next
  100. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  101. j = j + 1
  102. 'On Copie dans la feuille ES
  103. Range("ES!B" & j).Value = Concat ' colonne qui affichera le resultat ( ici colonne B)
  104. Range("ES!C" & j).Value = Range("LEQ!K" & Ligne).Value  'Désignation
  105. Range("ES!D" & j).Value = Range("LEQ!AW" & Ligne).Value 'E TOR
  106. Range("ES!E" & j).Value = Range("LEQ!AX" & Ligne).Value 'S TOR
  107. Range("ES!F" & j).Value = Range("LEQ!AY" & Ligne).Value 'E Ana
  108. Range("ES!G" & j).Value = Range("LEQ!AZ" & Ligne).Value 'E RTD
  109. Range("ES!H" & j).Value = Range("LEQ!BA" & Ligne).Value 'S ANA
  110. Range("ES!I" & j).Value = Range("LEQ!AO" & Ligne).Value 'Var.Freq
  111. Range("ES!J" & j).Value = Range("LEQ!AP" & Ligne).Value 'Dém
  112. Range("ES!K" & j).Value = Range("LEQ!AU" & Ligne).Value 'IS
  113. End If
  114. Next
  115. '<<<<<<<<<<<<<<<<<<<<<< Mise en forme Tableau <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  116. Sheets("ES" ).Select
  117.     Range("B2:K2" ).Font.Bold = True
  118.     Range("B2:K2" ).HorizontalAlignment = xlCenter
  119.     Range("B2:K2" ).VerticalAlignment = xlBottom
  120. ' On supprime les espaces dans les désignation
  121.     Columns("C:C" ).Select
  122.     Selection.Replace What:=" ", Replacement:="_", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  123.    
  124.      Cells.Select
  125.     Cells.EntireColumn.AutoFit
  126.    
  127. 'On ajoute les bouton pour la macro suivante
  128.         ActiveSheet.Buttons.Add(800, 70, 100, 30).Select
  129.     Selection.OnAction = "triage_pid"
  130.     Selection.Characters.Text = "Triage PID"
  131.          ActiveSheet.Buttons.Add(800, 120, 100, 30).Select
  132.     Selection.OnAction = "Formater_Tableau"
  133.     Selection.Characters.Text = "Mise en Forme"
  134.   Range("A1" ).Select
  135. End Sub
  136. '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  137. Sub triage_pid()
  138. ' On tri les PID
  139.     Dim rPlage_tri As Range
  140. Set rPlage_tri = ActiveSheet.Range("B3:K" & Range("B" & Rows.Count).End(xlUp).Row)
  141. rPlage_tri.Sort Key1:=Range("B4" ), Order1:=xlAscending, Header:=xlGuess, _
  142.         OrderCustom:=1, Orientation:=xlTopToBottom
  143. 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
n°2306323
Takama13
Posté le 04-10-2017 à 18:34:16  profilanswer
 

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

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

n°2306358
valerypeti​t
mode initiative
Posté le 06-10-2017 à 09:40:31  profilanswer
 

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
  7.     End If
  8.     Ligne_Lect = Ligne_Lect + 1
  9. 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
n°2306368
milfeuille​s
BF1: superbanane
Posté le 06-10-2017 à 10:28:39  profilanswer
 

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
  7.     End If
  8.     Ligne_Lect = Ligne_Lect + 1
  9. 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".

n°2306369
valerypeti​t
mode initiative
Posté le 06-10-2017 à 10:38:49  profilanswer
 

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

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
n°2306380
valerypeti​t
mode initiative
Posté le 06-10-2017 à 13:56:55  profilanswer
 

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
n°2306471
Marc L
Posté le 09-10-2017 à 17:49:43  profilanswer
 

 
            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 …
 

n°2306482
milfeuille​s
BF1: superbanane
Posté le 10-10-2017 à 04:08:53  profilanswer
 

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 ?

mood
Publicité
Posté le 10-10-2017 à 04:08:53  profilanswer
 

n°2306487
Marc L
Posté le 10-10-2017 à 08:54:49  profilanswer
 

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


n°2306591
milfeuille​s
BF1: superbanane
Posté le 12-10-2017 à 10:39:09  profilanswer
 

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

n°2306594
Marc L
Posté le 12-10-2017 à 11:28:30  profilanswer
 

 
            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é ?! …
 


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

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

 

Sujets relatifs
VBA : adapter un userform à plusieurs feuilles Remplacer le contenu d'une colonne dans ma base de donnée SQL
[Résolu] Aide URL RewritingVBA copier une valeur d'un tableau acces vers un autre sous condition
SAP SQL Importer un fichier excelVBA word supprimer lignes en doubles
VBA BO afficher le gestionnaire de rapportBesoin d'un coup de pouce en CSS
Executer du code VBA sur un outil web 
Plus de sujets relatifs à : Besoin d'aide en VBA Excel Concatener + déplacement de donnée



Copyright © 1997-2016 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR