Résolu-Conception d'une macro - déplacer en transposé des données brut

Q

QI dhuitre

XLDnaute Junior
Bonjour, s'il y a une personne qui s'ennuie et qui a des connaissances en vba j'ai une mission pour elle.

Je copie-colle des données d'un site internet dans la feuille "import site internet".
Certaines lignes sont fusionnées et d'autres non

Les lignes fusionnées le sont toujours par groupe de 5 car dans la dernière colonne, pour une même date, j'ai 5 valeurs. Et ses 5 valeurs, il faut les déplacer en transposé dans les colonnes adjacentes...

Dans le fichier il y a 3 onglets, l'onglet "import internet" qui permet de voir comment sont les données importées.
un onglet "explication" et un onglet "résultat souhaité".

Merci à l'âme généreuse qui prendra le temps d'étudier ma demande.
Ca ne presse pas à la minute, je vais faire environ un import par mois.

Cordialement
 

Pièces jointes

  • Liste_entrainement_forum.xls
    131 KB · Affichages: 35
Dernière édition:
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re : Conception d'une macro - déplacer en transposé des données brut

Bonjour QI dhuitre,

Une solution parmi d'autres :

Code: 
Sub Traitement()
Dim a As Range, i&, t
If [J2] <> "Sport Zones" Then Exit Sub 'si le tableau a été traité
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
[J:J].Borders.LineStyle = xlNone 'facultatif
[J:J].Interior.ColorIndex = xlNone 'facultatif
For Each a In Range("J3:J" & Rows.Count).SpecialCells(xlCellTypeConstants).Areas
  For i = 1 To 5
    a(i).Cut a(1, 7 - i)
  Next
Next
[J:J].Delete
With Range("A3:A" & Rows.Count)
  .UnMerge
  .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  With .Resize(, 2).SpecialCells(xlCellTypeConstants)
    t = .Value 'matrice, plus rapide
    For i = 1 To UBound(t)
      t(i, 1) = CDate(Replace(t(i, 1), ".", "/"))
      t(i, 2) = CDate(Replace(t(i, 2), ".", "/"))
    Next
    .Value = t
  End With
End With
End Sub
A+
 
Vote positif 0 Vote négatif
Q

QI dhuitre

XLDnaute Junior
Re : Conception d'une macro - déplacer en transposé des données brut

Bonjour et merci job75, c'est parfait.

Pour continuer la progression du fichier j'ai fait à l'aide de l'enregistreur ceci :

Code: 
Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Sheets("All").Select
    Range("C2").Select
    Selection.Insert Shift:=xlDown

Pour finalement copier ce que ta macro fait et l'inserer en ligne 2 d'une autre feuille pour que je puisse avoir toutes les données au même endroit. C'est fonctionnel mais s'il y a mieux je suis preneur :)
 

Pièces jointes

  • Liste entrainement.xls
    136.5 KB · Affichages: 24
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

Re,

Avec cette macro le traitement se fait dans la feuille "Résultat" :

Code: 
Sub Traitement()
Dim a As Range, i&, j As Byte, t
On Error Resume Next 's'il n'y a pas de SpecialCells
With Sheets("Résultat")
  Cells.Copy .Cells
  .[J:J].Borders.LineStyle = xlNone 'facultatif
  .[J:J].Interior.ColorIndex = xlNone 'facultatif
  .[K2:O2] = Array("50 à 59%", "60 à 69%", "70 à 79%", "80 à 89%", "90 à 100%")
 For Each a In .Range("J3:J" & Rows.Count).SpecialCells(xlCellTypeConstants).Areas
    For i = 1 To a.Count Step 5
      For j = 0 To 4
        a(i + j).Cut a(i, 6 - j)
      Next
    Next
  Next
  .[J:J].Delete
  With .Range("A3:A" & Rows.Count)
    .UnMerge
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    With .Resize(, 2).SpecialCells(xlCellTypeConstants)
      t = .Value 'matrice, plus rapide
      For i = 1 To UBound(t)
        t(i, 1) = CDate(Replace(t(i, 1), ".", "/"))
        t(i, 2) = CDate(Replace(t(i, 2), ".", "/"))
      Next
      .Value = t
    End With
  End With
  With .UsedRange: End With 'repositionne la barre de défilement verticale
  .Activate
End With
End Sub
PS : j'avais zappé le fait qu'il y a des séries de 5 valeurs qui se suivent (cellules fusionnées adjacentes).

J'ai donc inséré la boucle j dans la 1ère boucle i.

Fichier joint.

Bonne fin de soirée.
 

Pièces jointes

  • Liste_entrainement_forum(1).xls
    93 KB · Affichages: 28
Dernière édition:
Vote positif 0 Vote négatif
Q

QI dhuitre

XLDnaute Junior
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

Oui j'ai vu ça, là je suis en train de (sans toucher à ta macro car elle est parfaite) d'étudier comment je peux faire pour avoir une colonne "année" et extraire l'année de chaque date par ligne , a coté le mois, puis le numéro de semaine (ulterieurement je compte exploiter les données avec un TCD et ses colonnes (mois, année, semaine) serviront de filtre

Pour avoir le numéro de semaine c'est en partie réglé via se post https://www.excel-downloads.com/threads/resolu-fonction-no-semaine-en-vba.231568/ et si vraiment je coince je relancerais se sujet :)
 
Vote positif 0 Vote négatif
Q

QI dhuitre

XLDnaute Junior
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

Je suis désolé j'aurai du présenter le contexte autrement voire dès le début.

ce que j'importe depuis le site internet (qui est polarpersonnaltrainer), sont des enregistrement de mes séances cardiovasculaire. (temps, fréquence cardiaque etc...)
Ses séances sont enregistré dans mon cardiofréquencemetre puis transférer sur le site de polar.

Sur le site polar, la gestion des données est merdique et les graphiques qu'ils proposent me sont inutile.

Donc ce que je souhaite faire c'est tous les mois, importer les données du site de polar et les accumulés dans une feuille afin de, régulièrement, faire le point sur ma condition physique.

IL y a deux colonnes de dates mais elles seront toujours identiques sur la même ligne car ce n'est ni plus ni moins que la date du jour ou je commence l'exercice et que je le fini. Et comme ce ne sont que des exercices de 20 voire 30 minutes chacuns, la date de début et de fin sera toujours la même.

Donc pour récuperer le mois et l'année finalement, j'envisage simplement de copier la date de début et de formater les colonnes en mois "mmmm" et année "aaaa".

Je ne sais pas si je m'exprime bien.

C'est important pour moi de savoir où j'en suis physiquement car suite à une récente crise cardiaque, je dois maintenant remonter la pente et remuscler la partie de mon coeur qui n'est pas nécrosé pour compenser.
 
Dernière édition:
Vote positif 0 Vote négatif
Q

QI dhuitre

XLDnaute Junior
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

C'est vrai que finalement, extraire l'année et le mois c'était pas utile car dans le TCD j'ai pu filtrer comme je voulais (Année trimestre mois...). Voici une capture d'écran de ce que j'ai pu faire grâce à ta générosité (c'est pas très conventionnel ce que j'ai fais car le résultat de ta macro je l'ai copié collé dans une autre feuille mais je voulais pas te demander de re modifier quoi que ce soit) et du coup maintenant j'ai une assez bonne visibilité sur ce que je fais.

A titre d'exemple pour comprendre l'image qui est filtré sur 2015, je dois travailler physiquement pour toujours être dans la zone 2 et très peu dans la zone 3, et on voit bien qu'en fevrier ca n'était pas le cas ... Enfin bon, je ne vais pas m'étendre à raconter ma vie mais en tout cas merci pour le temps que tu as consacré à mon fichier, merci beaucoup beaucoup :)

Cordialement.
 

Pièces jointes

  • Sans titre.jpg
    Sans titre.jpg
    38.3 KB · Affichages: 28
  • Sans titre.jpg
    Sans titre.jpg
    38.3 KB · Affichages: 28
  • Sans titre.jpg
    Sans titre.jpg
    38.3 KB · Affichages: 23
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

Bonjour QI dhuitrre, le forum,

Fichier (2) avec ce nouveau code :

Code: 
Sub Traitement()
Dim a As Range, i&, j As Byte, t
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
With Sheets("Résultat")
  Sheets(1).Cells.Copy .Cells
  .[J:J].Borders.LineStyle = xlNone 'facultatif
  .[J:J].Interior.ColorIndex = xlNone 'facultatif
  .[K2:O2] = Array("50 à 59%", "60 à 69%", "70 à 79%", "80 à 89%", "90 à 100%")
 For Each a In .Range("J3:J" & Rows.Count).SpecialCells(xlCellTypeConstants).Areas
    For i = 1 To a.Count Step 5
      For j = 0 To 4
        a(i + j).Cut a(i, 6 - j)
      Next
    Next
  Next
  .[1:1].Delete
  .[J:J].Delete
  .[A1:B1] = Array("Date", "N° semaine")
  With .Range("A2:A" & Rows.Count)
    .UnMerge
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    With .SpecialCells(xlCellTypeConstants).Resize(, 2)
      t = .Value 'matrice, plus rapide
      For i = 1 To UBound(t)
        t(i, 1) = CDate(Replace(t(i, 1), ".", "/"))
        t(i, 2) = NoSemISO(t(i, 1))
      Next
      .Value = t
    End With
  End With
  With .UsedRange: End With 'repositionne la barre de défilement verticale
  .Activate
End With
End Sub

Function NoSemISO(d) 'norme ISO(Sem 4 Jrs mini)(de Renauder XLD)
Dim t&
t = DateSerial(Year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
NoSemISO = ((d - t - 3 + (Weekday(t) + 1) Mod 7)) \ 7 + 1
End Function
Bonne journée et A+
 

Pièces jointes

  • Liste_entrainement_forum(2).xls
    101.5 KB · Affichages: 24
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

Re,

Le couper-coller a(i + j).Cut a(i, 6 - j) prenait beaucoup trop de temps, utilisez cette macro :

Code: 
Sub Traitement()
Dim a As Range, i&, j As Byte, t
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
With Sheets("Résultat")
  Sheets(1).Cells.Copy .Cells
  '---formatage des colonnes K:O---
  .[K:O].NumberFormat = "hh:mm:ss"
  .[K:O].Font.Name = .[A3].Font.Name
  .[K:O].Font.Size = .[A3].Font.Size
  .[K:O].HorizontalAlignment = xlCenter
  .[K2:O2].Font.Bold = True
  .[K2:O2].VerticalAlignment = xlCenter
  .[K2:O2] = Array("50 à 59%", "60 à 69%", "70 à 79%", "80 à 89%", "90 à 100%")
  '---remplissage des colonnes K:O---
  For Each a In .Range("J3:J" & Rows.Count).SpecialCells(xlCellTypeConstants).Areas
    For i = 1 To a.Count Step 5
      For j = 0 To 4
        a(i, 6 - j) = a(i + j)
  Next j, i, a
  .[1:1].Delete
  .[J:J].Delete
  '---colonnes A:B---
  .[A1:B1] = Array("Date", "N° semaine")
  With .Range("A2:A" & Rows.Count)
    .UnMerge
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    With .SpecialCells(xlCellTypeConstants).Resize(, 2)
      t = .Value 'matrice, plus rapide
      For i = 1 To UBound(t)
        t(i, 1) = CDate(Replace(t(i, 1), ".", "/"))
        t(i, 2) = NoSemISO(t(i, 1))
      Next
      .Value = t
    End With
  End With
  With .UsedRange: End With 'repositionne la barre de défilement verticale
  .Activate
End With
End Sub
Fichier (3).

A+
 

Pièces jointes

  • Liste_entrainement_forum(3).xls
    94.5 KB · Affichages: 25
Vote positif 0 Vote négatif
Q

QI dhuitre

XLDnaute Junior
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

Bonjour job75 c'est gentil de faire tout ça pour moi :)
Je vais intégrer votre nouvelle macro mais si vous voulez vraiment...Comment dire faire évoluer mon fichier , si vous avez du temps il faudrait peut-être sauter une étape dans ce que j'ai fais moi.

De la feuille "import" avec votre macro, cela envoi les données dans la feuille "résultat" formaté comme il se doit.
Ce que j'ai écris ensuite, c'est de copier les éléments de la feuille résultat dans la feuille "All" à la suite des données précédente de façon a avoir l'historique complet.

C'est fonctionnel en l'état mais peut-être qu'il y a plus simple (exemple : copier directement les données de la feuille import dans la feuille "all" et ensuite mettre en forme.

Mais vu que je pige que dalle à votre macro, je n'ai même pas essayé.

A terme l'idéal aussi, c'est dès que j'importe des nouvelles données, pouvoir mettre à jour automatiquement le TCD mais je n'en suis pas encore là, j'ai essayé vaguement avec l'enregistreur de macro mais cela n'a pas été probant.

Mais vous n'êtes pas obligé de faire tout ça hein...J'en demandais pas tant mais c'est vrai que c'est plaisant d'avoir un fichier fonctionnel. J'ai mis le fichier au cas où ca vous interesse de sauter l'étape de la feuille résultat.
 

Pièces jointes

  • Cardio béta 1.xls
    209.5 KB · Affichages: 20
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : Résolu-Conception d'une macro - déplacer en transposé des données brut

Re,

Pour transférer à chaque fois en feuille "All" les données de la feuille "Résultat" c'est bien simple :

Code: 
'---transfert en feuille "All"---
.Rows(1).Copy Feuil2.[A1]
.UsedRange.Offset(1).Copy Feuil2.Range("A" & Rows.Count).End(xlUp)(2)
Feuil2.Cells.Sort Feuil2.[A1], xlDescending, Header:=xlYes 'tri décroissant
Mais ne cliquer qu'une seule fois sur le bouton...

Fichier joint.

A+
 

Pièces jointes

  • Cardio béta(1).xls
    148 KB · Affichages: 26
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2013 Utilisation de la fonction "Case" dans VBA
Réponses
12
Affichages
1 K
AnjyD
A
A
  • Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
1 K
Arnaud Legay
A
T
  • Résolu(e)
XL 2019 Déplacer et stocker des données importer d'un site internet automatiquement
Réponses
1
Affichages
812
sylvanu
sylvanu
A
  • Question
Microsoft 365 Modification de ligne automatique Tableau Excel
Réponses
2
Affichages
885
AlbertReporter
A
S
  • Question
Premier post : déplacer le contenu d'une cellule
Réponses
5
Affichages
1 K
soan
S
M
  • Question
Microsoft 365 Macro qui permet de creer des onglets en fonction depuis d'une liste déroulante
Réponses
0
Affichages
1 K
moussandiaye1987
M
D
  • Résolu(e)
Sélectionner données d'une feuille puis coller sur une autre sans les cellules vides
Réponses
6
Affichages
1 K
JHA
J
M
  • Résolu(e)
XL 2016 Formulaire Excel VBA : Afficher dynamiquement des cases à cocher en fonction d'une liste déroulante
Réponses
13
Affichages
5 K
MyloX
M
N
  • Question
Extraction d'information du code source d'une page web avec VBA
Réponses
6
Affichages
8 K
ninajams
N
N
  • Question
Remplacer par en fonction des données d'une feuille
Réponses
1
Affichages
492
eriiic
eriiic

Membres actuellement en ligne

25 membres et 246 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 089
Messages
2 085 206
Membres
102 820
dernier inscrit
SIEG68