Transfer les donnees d'une plage dans d'autres plage..

Guido

XLDnaute Accro
Bonsoir le Forum

Je recherches a transferer des lignes dans des plages bien définies selon le titre de la plage de base

Cette plage change tout les jours

Voir le fichier en piece jointe

Merci

Guido
 

Pièces jointes

  • Seléction final 2016.xls
    59.5 KB · Affichages: 42

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Je viens de modifier le fichier (13) puisque les arrivées sont entrées manuellement dans la feuille "Récap".

Les feuilles "TAB" étant remises à zéro quand on les active, il n'y a pas à prévoir d'emplacement pour elles.

A+
 

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Je viens de modifier le fichier (13) puisque les arrivées sont entrées manuellement dans la feuille "Récap".

Les feuilles "TAB" étant remises à zéro quand on les active, il n'y a pas à prévoir d'emplacement pour elles.

A+

Re

Merci job75 pour le fichier n°13.

C'est tout bon

En attendans de trouver une solution,avec le fichier ,avec lequel ,j'arrive a importer les arrivees

A bientôt

amitiés

Guido
 

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour Guido, le forum,

Dans ce fichier (14) j'ai supposé que l'ordre des arrivées était donné par les couleurs en colonne B.

Pour les couleurs des 3 premiers je me suis basé sur la course R4C6 (qui est un tiercé).

A vous de vérifier et d'adapter l'ordre des couleurs coul1 coul2 coul3 coul4 coul5 :

Code:
'---couleurs des arrivées---
Const coul1 = 48 'gris foncé pour le 1er
Const coul2 = 6 'jaune pour le 2ème
Const coul3 = 46 'orange pour le 3ème
Const coul4 = 8 'bleu pour le 4ème
Const coul5 = 15 'gris clair pour le 5ème

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Frecap As Worksheet, F As Worksheet, arr, i&, lig&, x$, P As Range, rc As Byte
Dim colrecap%, ligrecap&, y$, t, j As Byte, rang As Variant
Static recap As Boolean 'mémorise la variable
Set Frecap = Feuil1 'CodeName de la feuille Récap
Set F = Feuil2 'CodeName de la feuille Prono
arr = Array(coul1, coul2, coul3, coul4, coul5)
With Sh
  If .Name Like "TAB R#*" Then
    Application.ScreenUpdating = False
    .Cells.Clear 'RAZ
    lig = 1
    x = "Course: R." & Val(Mid(.Name, 6)) & "-*"
    For i = 1 To F.Cells(.Rows.Count, 2).End(xlUp).Row
      If F.Cells(i, 2) Like x Then
        '---copie du tableau source---
        Set P = F.Range(F.Cells(i, 1), F.Cells(i + 6, 2).CurrentRegion)
        rc = P.Rows.Count
        P.Copy .Cells(lig, 1)
        .Rows(lig + rc - 10) = "": .Cells(lig + rc - 10, 2) = "Chevaux"
        '---initialisation et en-têtes des tableaux dans Récap---
        If recap Then
          colrecap = 6 * Val(Mid(.Name, 6)) - 5
          ligrecap = Frecap.Columns(colrecap) _
            .Find("", Frecap.Cells(2, colrecap), xlValues, , xlByColumns).Row
          y = Trim(Mid(P(1, 2), 9, 8))
          y = Replace(Replace(y, ".", ""), "-", "")
          If ligrecap = 3 Then Frecap.Cells(2, colrecap) = Split(y, "C")(0)
          Frecap.Cells(ligrecap, colrecap) = y
          Frecap.Cells(ligrecap + 14, colrecap) = y '2ème tableau (arrivées)
        End If
        '---traitement du milieu du tableau---
        With .Cells(lig + 8, 1).Resize(rc - 18, 8) '2 colonnes auxiliaires G et H
          .Columns(7).Resize(, P.Columns.Count - 6).Clear 'RAZ à partir de la colonne G
          .Columns(3).Clear 'RAZ colonne C
          .Columns(3).HorizontalAlignment = xlCenter 'centrage
          t = .Value 'matrice, plus rapide
          For j = 1 To rc - 18
            rang = Application.Match(.Cells(j, 2).Interior.ColorIndex, arr, 0)
            If IsNumeric(rang) Then t(j, 1) = rang Else t(j, 1) = ""
            t(j, 4) = Val(Replace(t(j, 4), ",", "."))
            t(j, 5) = Val(Replace(t(j, 5), ",", "."))
            t(j, 3) = t(j, 4) - t(j, 5)
            If t(j, 3) < 0 Then
              t(j, 7) = -t(j, 3)
            ElseIf t(j, 3) > 0 Then 'valeurs zéro non traitées
              t(j, 8) = t(j, 3)
            End If
          Next j
          .Value = t
          .Sort .Columns(7), xlAscending, Header:=xlNo 'tri des valeurs < 0
          If .Cells(1, 7) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 3: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(rc - 16, 5)
            .Cells(1, 2).Copy .Cells(rc - 17, 5)
            If recap Then Frecap.Cells(ligrecap, colrecap + 1) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 2) = .Cells(1, 2)
          End If
          .Sort .Columns(8), xlAscending, Header:=xlNo 'tri des valeurs > 0
          If .Cells(1, 8) <> "" Then
            .Cells(1, 3).Interior.ColorIndex = 49: .Cells(1, 3).Font.ColorIndex = 6
            .Cells(1, 3).Copy .Cells(rc - 16, 6)
            .Cells(1, 2).Copy .Cells(rc - 17, 6)
            If recap Then Frecap.Cells(ligrecap, colrecap + 3) = .Cells(1, 3): _
              Frecap.Cells(ligrecap, colrecap + 4) = .Cells(1, 2)
          End If
          .Columns(7).Resize(, 2) = "" 'RAZ des colonnes auxiliaires
          .Sort .Columns(1), xlAscending, Header:=xlNo 'tri dans l'ordre des arrivées
          '---remplissage du 2ème tableau (arrivées)---
          If recap Then
            For j = 1 To 4
              If .Cells(j, 1) = "" Or .Cells(j, 1) > 4 Then Exit For
              Frecap.Cells(ligrecap + 14, colrecap + .Cells(j, 1)) = .Cells(j, 2)
            Next j
          End If
          '---mise en forme de la 1ère colonne---
          j = Application.Count(.Columns(1))
          If j Then
            With .Columns(1).Resize(j)
              .Borders.Weight = xlThin
              .Interior.ColorIndex = 16 'gris
              .Font.ColorIndex = 6 'jaune
              .HorizontalAlignment = xlCenter
            End With
          End If
        End With
        '---bordures---
        .Cells(lig, 2).Resize(rc, P.Columns.Count - 1).Borders.Weight = xlThin
        lig = lig + rc
      End If
    Next i
  ElseIf .Name = Frecap.Name Then
    Application.ScreenUpdating = False
    .[2:2].Replace "R*", "", xlWhole 'RAZ
    .[3:12,17:26].ClearContents 'RAZ
    recap = True
    For Each Sh In Worksheets
      If Sh.Name Like "TAB R#*" Then Workbook_SheetActivate Sh
    Next Sh
    recap = False
  End If
  ActiveCell.Select
  With .UsedRange: End With 'actualise la barre de défilement
End With
End Sub
Les tableaux des arrivées en feuille "Récap" sont maintenant remplis automatiquement.

Bonne journée.
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(14).xls
    264 KB · Affichages: 46
Dernière édition:

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour job75 et le forum

Je voulais redonner la precision pour savoir quelle sont les couleurs selon l'ordre d'arrivée

Voici 3 capture d'ecran

le 1er est en bleu

le 2em en vert

le 3em en jaune

le 4em en rouge et le 5em en gris clair.

C'est manuellement que je rentre les arrivées

Merci pour votre travail

a plus
Guido
 

Pièces jointes

  • Capture avant le depart de la course.jpg
    Capture avant le depart de la course.jpg
    63.6 KB · Affichages: 38
  • Capture de l'arrivee.PNG
    Capture de l'arrivee.PNG
    21.8 KB · Affichages: 34
  • Capture apres l'arrivee.jpg
    Capture apres l'arrivee.jpg
    56.6 KB · Affichages: 33

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Je ne vois pas comment vous arrivez à ces conclusions.

Sur le fichier sur lequel on travaille ici il n'y a pas de couleur verte ou rouge en colonne B.

Avez-vous au moins compris ce que j'ai fait au post #19 ?

A+
 

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour job75 et le forum

Je voulais redonner la precision pour savoir quelle sont les couleurs selon l'ordre d'arrivée

Voici 3 capture d'ecran

le 1er est en bleu

le 2em en vert

le 3em en jaune

le 4em en rouge et le 5em en gris clair.

C'est manuellement que je rentre les arrivées

Merci pour votre travail

a plus

Guido

Re

job75

Sur le fichier avec lequel ont travail c'est la couleur grise foncée qui fait figure de 2em,

c'est pour cela que je demandais si il etais possible de modifier la macro et de remplacer le gris foncé par le vert.

Merci pour tout

amitiés

Guido
 

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

On travaille toujours au compte-gouttes avec vous !!!

Quel doit être la valeur de la propriété .Interior.ColorIndex pour le vert du 2ème ???

Et la couleur rouge du 4ème, elle doit remplace quelle couleur ??? [Edit] en fait il s'agit peut-être de la couleur orange ???

J'en ai profité pour modifier légèrement la macro du fichier (14) :

Code:
'---
          '---remplissage du 2ème tableau (arrivées)---
          If recap Then
            For j = 1 To 4
              If .Cells(j, 1) = "" Or .Cells(j, 1) > 4 Then Exit For
              Frecap.Cells(ligrecap + 14, colrecap + .Cells(j, 1)) = .Cells(j, 2)
            Next j
          End If
A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Pour terminer avec le pompon du post #20 :

C'est manuellement que je rentre les arrivées

Si vous entrez les arrivées manuellement, quel serait l'intérêt de modifier les couleurs en colonne B ?

De toute façon, comme je l'ai dit, ce n'est pas possible puisque les feuilles sont remises à zéro quand on les active.

A+
 

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Re,

Dans ce fichier (14 bis) j'utilise l'ordre des couleurs que vous indiquez au post #20.

La couleur gris foncé est modifiée par ce code :

Code:
If .Cells(j, 2).Interior.ColorIndex = 48 Then 'remplacement du gris foncé
  .Cells(j, 2).Interior.ColorIndex = coul2
  .Cells(j, 2).Font.ColorIndex = 6 'jaune
End If
Comme je l'ai dit il n'y a pas de 1er pour la course R4C6 :rolleyes:

A+
 

Pièces jointes

  • TABLEAUX DES COURSES TRANSFEREES 2016(14 bis).xls
    265 KB · Affichages: 43

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour job75 et le forum

Je voulais redonner la precision pour savoir quelle sont les couleurs selon l'ordre d'arrivée

Voici 3 capture d'ecran

le 1er est en bleu

le 2em en vert

le 3em en jaune

le 4em en rouge et le 5em en gris clair.

C'est manuellement que je rentre les arrivées

Merci pour votre travail

a plus
Guido

Re

job75

Légende des signification des couleurs:

Bleu: Gagnant
Vert: Second
Jaune: Troisième
Marron: Quatrième
Rouge: Cinquième

Voila une capture du livre ci dessus

Et pour en finir avec ce fichier

J'aimerais rentrer les arrivées manuellement,

quelles sont les lignes a supprimer dans la macros afin de suprimés les affichages automatique

dans la page recap.

je le ferais en direct sitot apres l'affichage definitive de l'arrivee sur internet.

J'etais obligé d'avancer petit a petit sur ce fichier.Merci pour votre patience,

a bientot

bonne fin de soiree

Guido
 

Guido

XLDnaute Accro
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour job et le Forum

PRECISION IMPORTANTE:

Les chiffres qui se trouvent dans la colonne B represente le classement des chx classer de la plus petite cote a la plus grande cote.

Et NON le classement de l'arrivee.

Les arrivees sont a rentrer manuellement pour le moment

Merci pour votre attention,

Re

job75

je ne comprend pas votre reaction ,alors que je Vous donnent toutes les

explications importantes.

Lire plus haut...

Merci

sans Vous faché ...????

Amitiés

Guido
 

job75

XLDnaute Barbatruc
Re : Transfer les donnees d'une plage dans d'autres plage..

Bonjour Guido, le forum,

Ce que vous n'arrivez pas à comprendre Guido c'est ceci, pourtant évident :

- soit vous entrez les arrivées manuellement en feuille "Récap", alors utilisez le fichier (13)

- soit les arrivées sont déterminées par les couleurs en colonne B de la feuille "Prono", alors utilisez le fichier (14) ou (14 bis).

Pour moi ce fil est terminé.

Bonne journée.
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 210
Messages
2 107 299
Membres
109 796
dernier inscrit
aelgar