IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

VBA : nommées une feuille de calcul et Invite


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre averti
    Homme Profil pro
    RETRAITE
    Inscrit en
    Août 2018
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations professionnelles :
    Activité : RETRAITE

    Informations forums :
    Inscription : Août 2018
    Messages : 32
    Par défaut VBA : nommées une feuille de calcul et Invite
    Bonjour,

    J'ai une feuille "poule" qui contient des joueurs à ventiler dans des tableaux à l'aide d'une feuille de correspondance via un bouton "Ventilation" qui fonctionne très bien, mais qui mérite quelques petits aménagements pour la suite de mon projet.

    Actuellement, les feuilles dupliquées sont nommées comme suit par exemple « T4 Série C06 » qui correspond au tableau utilisé + le numéro de série . 18 feuilles sont créés correspondant chacune à une série.

    Ainsi, je souhaiterai à ce que les feuilles dupliquées soient nommées par le numéro de série uniquement à la place de l'exemple ci-dessus. Exemple : C00,C01,C02 etc….

    En outre, avoir la possibilité de dupliquer qu'une seule série à la place de tout avoir en bloc comme actuellement

    Enfin, il peut y avoir un bugg dans le cas où, le nombre de joueurs par série est inférieur à 4, comment je peux contourner le PB

    Merci d’avance. Ce n'est pas parfait comme code, mais il fonctionne

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
     
    Sub Ventilation()
     
    '*********Déclarations**********'
    Dim TAB_C0(), TAB_C1(), TAB_C2(), TAB_C3(), TAB_C4(), TAB_C5C(), TAB_C5A(), TAB_C6(), TAB_C7(), TAB_C8(), TAB_C9(), TAB_C10(), TAB_C11(), TAB_C12(), TAB_C13(), TAB_C14(), TAB_C15(), TAB_C16()
     
     
    '*********Capture des Tableaux de POULES**********'
    TAB_C0 = Range("serie_C00").Value
    TAB_C1 = Range("serie_C01").Value
    TAB_C2 = Range("serie_C02").Value
    TAB_C3 = Range("serie_C03").Value
    TAB_C4 = Range("serie_C04").Value
    TAB_C5A = Range("serie_C5A").Value
    TAB_C5C = Range("serie_C5C").Value
    TAB_C6 = Range("serie_C06").Value
    TAB_C7 = Range("serie_C07").Value
    TAB_C8 = Range("serie_C08").Value
    TAB_C9 = Range("serie_C09").Value
    TAB_C10 = Range("serie_C10").Value
    TAB_C11 = Range("serie_C11").Value
    TAB_C12 = Range("serie_C12").Value
    TAB_C13 = Range("serie_C13").Value
    TAB_C14 = Range("serie_C14").Value
    TAB_C15 = Range("serie_C15").Value
    TAB_C16 = Range("serie_C16").Value
     
     
     
    '**************Création du Tableau C0*************'
    Call Creation_Tableau(TAB_C0)
    '**************Création du Tableau C1*************'
    Call Creation_Tableau(TAB_C1)
    '**************Création du Tableau C2*************'
    Call Creation_Tableau(TAB_C2)
    '**************Création du Tableau C3*************'
    Call Creation_Tableau(TAB_C3)
    '**************Création du Tableau C4*************'
    Call Creation_Tableau(TAB_C4)
    '**************Création du Tableau C5A*************'
    Call Creation_Tableau(TAB_C5A)
    '**************Création du Tableau C5C*************'
    Call Creation_Tableau(TAB_C5C)
    '**************Création du Tableau C6*************'
    Call Creation_Tableau(TAB_C6)
    '**************Création du Tableau C7*************'
    Call Creation_Tableau(TAB_C7)
    '**************Création du Tableau C8*************'
    Call Creation_Tableau(TAB_C8)
    '**************Création du Tableau C9*************'
    Call Creation_Tableau(TAB_C9)
    '**************Création du Tableau C10*************'
    Call Creation_Tableau(TAB_C10)
    '**************Création du Tableau C11*************'
    Call Creation_Tableau(TAB_C11)
    '**************Création du Tableau C12*************'
    Call Creation_Tableau(TAB_C12)
    '**************Création du Tableau C13*************'
    Call Creation_Tableau(TAB_C13)
    '**************Création du Tableau C14*************'
    Call Creation_Tableau(TAB_C14)
    '**************Création du Tableau C15*************'
    Call Creation_Tableau(TAB_C15)
    '**************Création du Tableau C16*************'
    Call Creation_Tableau(TAB_C16)
     
     
    End Sub
     
    Function Creation_Tableau(TAB_TEMP)
     
    Dim TAB_Final()
     
    TAB_Final = Traitement(TAB_TEMP)
    T_Temp = Select_TXX(TAB_Final(1, 1))
     
    Nom_Feuille = T_Temp & " " & TAB_TEMP(1, 1)
     
    Application.DisplayAlerts = False
    If Sht(Nom_Feuille) = True Then Sheets(Nom_Feuille).Delete
    Application.DisplayAlerts = True
     
    Sheets(T_Temp).Copy After:=Sheets(T_Temp)
    ActiveSheet.Name = Nom_Feuille
     
    Call Create_Final(T_Temp, TAB_Final)
     
    End Function
     
     
     
    Function Create_Final(T_Temp, TAB_Final)
     
    Indice = 2
     
    Select Case T_Temp
     
        Case Is = "T64"
            For i = 2 To 130
                Range("B" & i) = TAB_Final(Indice, 1)
                Range("C" & i) = TAB_Final(Indice, 2)
                i = i + 1
                Indice = Indice + 1
            Next i
     
        Case Is = "T32"
            For i = 2 To 66
                Range("B" & i) = TAB_Final(Indice, 1)
                Range("C" & i) = TAB_Final(Indice, 2)
                i = i + 1
                Indice = Indice + 1
            Next i
     
        Case Is = "T16"
     
            For i = 2 To 34
                Range("B" & i) = TAB_Final(Indice, 1)
                Range("C" & i) = TAB_Final(Indice, 2)
                i = i + 1
                Indice = Indice + 1
            Next i
     
        Case Is = "T8"
     
            For i = 2 To 18
                Range("B" & i) = TAB_Final(Indice, 1)
                Range("C" & i) = TAB_Final(Indice, 2)
                i = i + 1
                Indice = Indice + 1
            Next i
     
        Case Is = "T4"
     
            For i = 2 To 10
                'If i = 6 Then i = 8
                Range("B" & i) = TAB_Final(Indice, 1)
                Range("C" & i) = TAB_Final(Indice, 2)
                i = i + 1
                Indice = Indice + 1
            Next i
    End Select
     
     
    End Function
     
    Function Traitement(TAB_TEMP)
        Dim DIC_C0
        Dim TAB_Sortie()
     
        Set DIC_C0 = CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(TAB_TEMP, 1)
            If TAB_TEMP(i, 2) = 1 Or TAB_TEMP(i, 2) = 2 Then DIC_C0.Add TAB_TEMP(i, 3), TAB_TEMP(i, 1)
        Next i
     
        TAB_Sortie = Range("Sortie_" & DIC_C0.Count).Value
     
        ReDim Preserve TAB_Sortie(1 To UBound(TAB_Sortie, 1), 1 To 2)
     
        For i = 2 To UBound(TAB_Sortie, 1)
            If DIC_C0.exists(TAB_Sortie(i, 1)) Then TAB_Sortie(i, 2) = DIC_C0(TAB_Sortie(i, 1))
        Next i
        Traitement = TAB_Sortie
    End Function
     
     
    Function Select_TXX(TEMP)
     
    Dim T_Temp As String
     
    Select Case TEMP
     
        Case Is > 32
                T_Temp = "T64"
        Case Is > 16
                T_Temp = "T32"
        Case Is > 8
                T_Temp = "T16"
        Case Is > 4
                T_Temp = "T8"
        Case Else
                T_Temp = "T4"
    End Select
    Select_TXX = T_Temp
     
    End Function
     
    Function Sht(Name) As Boolean
        Dim s As Object
        On Error Resume Next
        Set s = Sheets(Name)
        If Err = 0 Then Sht = True
        Set s = Nothing
    End Function
    Fichiers attachés Fichiers attachés

  2. #2
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Re,

    Tu n'as plus de problèmes avec tes Range ? Surprenant ...

  3. #3
    Membre averti
    Homme Profil pro
    RETRAITE
    Inscrit en
    Août 2018
    Messages
    32
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Pas de Calais (Nord Pas de Calais)

    Informations professionnelles :
    Activité : RETRAITE

    Informations forums :
    Inscription : Août 2018
    Messages : 32
    Par défaut
    Bonjour Patrice,

    Non, je n'ai aucun souci avec mes "Range", la macro fonctionne très bien, en revanche si tu peux me donner un coup de main sur ces 3 aménagements je suis preneur si c'est possible.

    Mais je n'ai pas oublié ce qu'il faut faire sur le sujet soit : de préciser à quelle feuille ils appartiennent les "Range".

    Bonne soirée

  4. #4
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    13 176
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 13 176
    Billets dans le blog
    53
    Par défaut
    Bonjour,
    Pourquoi ouvrir une nouvelle discussion sur le même sujet ?
    Si tu ne reçois pas de réponse, il y a toujours des raisons
    Soit le sujet n'intéresse pas certains contributeurs, soit la question est mal comprise, incomplète ou encore trop vaste


    Non, je n'ai aucun souci avec mes "Range", la macro fonctionne très bien, en revanche si tu peux me donner un coup de main sur ces 3 aménagements je suis preneur si c'est possible.
    Mais je n'ai pas oublié ce qu'il faut faire sur le sujet soit : de préciser à quelle feuille ils appartiennent les "Range".
    Alors pourquoi dans cette nouvelle discussion ne pas avoir suivi les conseils prodigués par Patrice, que je salue au passage, dans sa réponse
    Ne pas l'oublier c'est bien, l'appliquer c'est mieux
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

Discussions similaires

  1. transferer un tableau VBA vers une feuille de calcul
    Par hugtohug dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 07/08/2016, 16h05
  2. comment transferer une tableau VBA vers une feuille de calcul
    Par Bonero dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 16/01/2010, 17h30
  3. [VBA-E97]Code pour déprotéger une feuille de calcul
    Par blaiso dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 19/04/2007, 11h30
  4. [VBA-E] Nommer chemin d'accès dans une feuille de calcul.
    Par BRUNO71 dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 09/03/2007, 13h30
  5. [VBA-E] Passer d'un contrôle à l'autre avec tab dans une feuille de calculs
    Par small_heart dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 23/02/2007, 20h57

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo