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 :

Distribution d une concaténation sous condition


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Inscrit en
    Janvier 2011
    Messages
    97
    Détails du profil
    Informations forums :
    Inscription : Janvier 2011
    Messages : 97
    Par défaut Distribution d une concaténation sous condition
    merci d avance sincerement

    donc cette procédure se situe ds la page en question .... une dernière question etant donné que je dois copier coller chacune des plages déterminées ds ce code pensez vous que ce code pourrait marcher

    Donc ds ma page active ou je veux declencher cet evenement a partir d un clique sur une cellule colone D dc je dois inserer cela si je me trompe pas


    Code :
    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
     
    Private Sub Workbook_Open()
     
     
       Call CréatNoms
     
    End Sub
     
     
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     
     
    Call crea_page
    'Call Select_Data
    'Call varcop
    Call contpart
    Call TypOpe
    Call transvalneg
     
     
    End Sub
    en faite je veux à travers ce code faire une concatenation par exemple si je clique sur D28 de tout les CLI_2 ...REC_2 et ensuite les envoyer ds un petit tableau en faite je pense mal m y prendre


    dc ensuite ds mon module je cree la page et le tableau
    je selectione donc les data de la concatenation, je copie mes variables selon la destination

    ce code peut il le faire
    dc vu q on range en Feuille Nom en M2 c est pas bon mais je sais pas comment les faire aller comme j indique ds Determine destination variables ds "deal" worksheet

    Code :
    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
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
     
    Public Sub CréatNoms()
     
     
    Dim débnoms As Range
    Dim listnoms As Range
    Dim nom As Range
    Dim i As Integer
     
    Set débnoms = Sheet("BOOK").Range("A26")
     
    Set listnoms = Range(débnoms, débnoms.End(xlToRight))
     
    For Each nom In listnoms
       For i = 1 To 50
            ActiveWorkbook.Names.Add Name:=nom.Value & "_" & i, RefersToR1C1:=nom.Offset(i, 0)
        Next
    Next
     
    End Sub
     
    Sub crea_page()
    '
    '
    '   Création nouvelle page avec le numero du deal
     
    Set MaFeuille = ActiveSheet
     
    nom = ActiveCell.Value
     
     
    'On verifie que le nom n'existe pas déjà
    On Error Resume Next 'en cas d'erreur, on continu sans generer d'erreur
    Set MaNewFeuille = Sheets(nom)
    On Error GoTo 0 'on réactive la gestion d'erreur
    'On verifie si la variable a obtenu un objet ou non
    If Not MaNewFeuille Is Nothing Then message = MsgBox("Voulez vous ?", vbRetryCancel + vbQuestion, "Mon programme")     'Exit Sub ' Si elle existe déjà Msg soit annule ou remplace
     
     
    'Sinon on continu
    'Add retourne un objet Worksheet, que tu recupere dans MaNewFeuille
    Set MaNewFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
     
    'Renome la nouvelle feuille
    MaNewFeuille.Name = nom
     
     
     
    '   Creation tab et mise en page
     
     
    Sheets("REF").Select
    Range("A1:E17").Select
        Selection.Copy
        Sheets(nom).Select
        ActiveSheet.Paste
     
        Columns("B:B").ColumnWidth = 20.29
        Columns("C:C").ColumnWidth = 6.29
        Columns("D:D").ColumnWidth = 15.43
        Rows("3:3").RowHeight = 20.25
        Rows("4:4").RowHeight = 15.75
        Rows("5:5").RowHeight = 15.75
        Rows("6:6").RowHeight = 15.75
        Rows("7:7").RowHeight = 15.75
        Rows("8:8").RowHeight = 15.75
        Rows("9:9").RowHeight = 15.75
        Rows("10:10").RowHeight = 15.75
        Rows("11:11").RowHeight = 15.75
        Rows("12:12").RowHeight = 15.75
        Rows("13:13").RowHeight = 15.75
        Rows("14:14").RowHeight = 15.75
        Rows("15:15").RowHeight = 15.75
        Rows("16:16").RowHeight = 15.75
     
         Range("C4:D4").ClearContents
         Range("C6:D8").ClearContents
         Range("C10:D16").ClearContents
     
     
    With Range("C13:D13")
       .Font.Bold = False
       .Font.Bold = True
       .Font.Italic = False
       .Font.Italic = True
    End With
     
     End Sub
     
     
     
    Sub Select_Data()
     
    ' regroupement des données
     
    Dim listdon As Variant
    Dim lign As Byte
    Dim donexp As String
     
     
     
    With Target
            If .Column <> 4 Or .Row < 27 Then Exit Sub
            lign = .Row - 26
            listdon = Array("CLI", "REC", "PAY", "PAY", "DS", "SF", "VD", "AMCCY1", "AMCCY2", "CCYO", "CCYT", "RATE")
            donexp = ""
            For Each donnée In listdon
                    donexp = donexp & Range(donnée & "_" & lign)
            Next donnée
            Sheets(nom).Range("M" & lign).Value = donexp
    End With
     
     
     
    End Sub
     
     
    '   Déclarer variables à copier sachant que chaque variable va etre numerote dc il faut mettre les rec_1 avec tout les autres en _1 et renvoyer chacune ds le champs du ticket
     
    Sub varcop(ByVal Target As Range)
     
        Dim CLI As Range
     
        Dim REC As Range
     
        Dim PAY As Range
     
        Dim DS As Range
     
        Dim SF As Range
     
        Dim VD As Range
     
        Dim AMCCY1 As Range
     
        Dim AMCCY2 As Range
     
        Dim CCYO As Range
     
        Dim CCYT As Range
     
        Dim RATE As Range
     
     
     
    '  Determine destination variables ds "deal" worksheet
     
     With Target
     
        For i = 1 To 50
     
            Set CLI = CLI & "_" & i = Sheets(nom).Range("C6:D6")
     
            Set REC = REC & "_" & i = Sheets(nom).Range("C14:D14")
     
     
            Set PAY = PAY & "_" & i = Sheets(nom).Range("C15:D15")
     
     
            Set DS = DS & "_" & i = Sheets(nom).Range("C4:D4")
     
     
            Set SF = SF & "_" & i = Sheets(nom).Range("C7:D7")
     
     
            Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")
     
     
        If Worksheets("2401").Range("G27").Value > 0 Then
            Set AMCCY1 = AMCCY1 & "_" & i = Sheets(nom).Range("D11")
        Else
            Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
        End If
     
     
        If Worksheets("2401").Range("H27").Value < 0 Then
            Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
        Else
            Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D11")
        End If
     
        If Worksheets("2401").Range("G27").Value > 0 Then
            Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C11")
        Else
            Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C12")
        End If
     
        If Worksheets("2401").Range("H27").Value < 0 Then
            Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C12")
        Else
            Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C11")
        End If
     
            Set RATE = RATE & "_" & i = Sheets(nom).Range("C13:D13")
     
    End With
       Next i
     
     
    '   Transfer PO data
     
     Dim intcount As Integer
        For intcount = 1 To 11
            For i = 1 To 10
                Select Case intcount
                Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
                Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
                Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
                Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
                Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
                Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
                Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
     
                        'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
     
                Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
     
                         'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
     
                Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
                Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
                Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
            End Select
            Next i
        Next intcount
     
    End Sub

    le probleme de mon programme se trouve la ds select_data et varcop ... mais alors le trouver je pense je m y prends mal pr la destination en fonction de la concatenation ...

    MERCI D AVANCE

  2. #2
    lvr
    lvr est déconnecté
    Membre éclairé Avatar de lvr
    Profil pro
    Responsable de projet fonctionnel
    Inscrit en
    Avril 2006
    Messages
    920
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations professionnelles :
    Activité : Responsable de projet fonctionnel
    Secteur : Arts - Culture

    Informations forums :
    Inscription : Avril 2006
    Messages : 920
    Par défaut
    Pourrais-tu mieux décrire ce que tu souhaites faire et le faire séquentiellement, car là c'est peu compréhensible.

    En plus ton code est peu lisible !!!

    C'est quoi cette structure ?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")
    Je ne comprends pas non plus la partie
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
    For Each nom In listnoms
       For i = 1 To 50
            ActiveWorkbook.Names.Add Name:=nom.Value & "_" & i, RefersToR1C1:=nom.Offset(i, 0)
        Next
    Next
    Pourquoi crées-tu des Names que tu ne réutilises pas après ?

  3. #3
    Membre confirmé
    Inscrit en
    Janvier 2011
    Messages
    97
    Détails du profil
    Informations forums :
    Inscription : Janvier 2011
    Messages : 97
    Par défaut
    tout d abord merci pr ton aide


    En faite,

    pr etre precis, je cherche a qd je selectionne une cellule ds la colone D de la page active à rassembler les données concernant cette cellule d ou la concatenation .....

    ensuite une fois nommées et rassemblées je veux renvoyer ces données ds un petit tableau



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     
     Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")
    en faite je définis VD une date ayant comme destination 'C8,D8' et vu que il y aura un VD_1 et plusieurs VD_
    je pensais faire cela pour que par exemple qd je clique la cellule D27 il rassemble toutes les données CLI_2, VD_2 ....
    et renvoyées ces dernieres vers leur destination ....

    a travers cette phrase de code je pensais que si VD est égale a VD_2 par exemple il renverra vers C8,D8 sachant qil peut y avoir un VD_50 un if ne suffirait pas ...


    peut etre je ne suis pas obligé de faire une concatenation pour rassembler les données correspondants a une cellule cliquée pour les copier coller ds un tableau sous condition

    on m a proposé une formule pr select les datas a cote mais je vois pas comment l appliquer pour coller les données en fonction de mon code

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
     
    Public Sub select_data_()
    For i = 1 To 10
            If Selection = Range("D" & i) Then
            Selection = Range("A" & i, ActiveCell.Offset(0, 12))
            End If
    Next i
    End Sub
    je sais pas d ou ma demande

    en tout cas un grand merci à tous

  4. #4
    Membre confirmé
    Inscrit en
    Janvier 2011
    Messages
    97
    Détails du profil
    Informations forums :
    Inscription : Janvier 2011
    Messages : 97
    Par défaut
    merci d avance

    voila après cette concaténation, je voudrais mettre si je clique D27
    mettre CLI_1 ds Sheets(nom).Range("C6,D6"), REC_1 dans Sheets(nom).Range("C14,D14")
    ..... PAY_1 ds Sheets(nom).Range("C15,D15"),
    DS_1 dans Sheets(nom).Range("C4,D4"),
    SF dans Sheets(nom).Range("C7,D7"), VD_1 dans Sheets(nom).Range("C8,D8")
    et mettre RATE_1 ds Sheets(nom).Range("C13,D13")

    et apres la destination de AMCY1_1 serait sous condition comme ici, pareil pr AMCY2_1 , pareil pour CCYO_1 et CCYT_1
    sachant que si je clique D28 ça sera les memes noms CLI,REC .... mais avec le N°2 ... comme CLI_2 ... mais la destination restera la meme Sheets(nom).Range("C6,D6"), pour CLI_2 .........................



    mon probleme reside ds la distribution de ces données concaténées ....


    j'ai rédigé ce code mais je pense je m y prends mal je suis réellement bloqué ... merci d avance

    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
     
     
    Sub Select_Data(ByVal Target As Range)
     
    ' regroupement des données
     
    Dim listdon As Variant
    Dim lign As Byte
    Dim donexp As String
    Dim i As Integer
     
     
     
        With Target
                If .Column <> 4 Or .Row < 27 Then Exit Sub
                lign = .Row - 26
                listdon = Array("CLI", "REC", "PAY", "PAY", "DS", "SF", "VD", "AMCCY1", "AMCCY2", "CCYO", "CCYT", "RATE")
                donexp = ""
            For Each donnée In listdon
                donexp = donexp & Range(donnée & "_" & lign)
            Next donnée
            Sheets(nom).Range("M" & lign).Value = donexp
        End With
     
    'For i = 1 To 10
           ' If Selection = Range("D" & i) Then
           ' Selection = Range("A" & i, ActiveCell.Offset(0, 12))
           ' End If
    'Next i
     
     
     
    End Sub
     
     
    '   Déclarer variables à copier sachant que chaque variable va etre numerote dc il faut mettre les rec_1 avec tout les autres en _1 et renvoyer chacune ds le champs du ticket
     
    Sub varcop(ByVal Target As Range)
     
        Dim CLI As Range
        Dim REC As Range
        Dim PAY As Range
        Dim DS As Range
        Dim SF As Range
        Dim VD As Range
        Dim AMCCY1 As Range
        Dim AMCCY2 As Range
        Dim CCYO As Range
        Dim CCYT As Range
        Dim RATE As Range
     
     
     
    '  Determine destination variables ds "deal" worksheet
     
     With Target
     
        For i = 1 To 50
     
            Set CLI = CLI & "_" & i = Sheets(nom).Range("C6:D6")
            Set REC = REC & "_" & i = Sheets(nom).Range("C14:D14")
            Set PAY = PAY & "_" & i = Sheets(nom).Range("C15:D15")
            Set DS = DS & "_" & i = Sheets(nom).Range("C4:D4")
            Set SF = SF & "_" & i = Sheets(nom).Range("C7:D7")
            Set VD = VD & "_" & i = Sheets(nom).Range("C8:D8")
     
     
        If Worksheets("2401").Range("G27").Value > 0 Then
            Set AMCCY1 = AMCCY1 & "_" & i = Sheets(nom).Range("D11")
        Else
            Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
        End If
     
     
        If Worksheets("2401").Range("H27").Value < 0 Then
            Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D12")
        Else
            Set AMCCY2 = AMCCY2 & "_" & i = Sheets(nom).Range("D11")
        End If
     
        If Worksheets("2401").Range("G27").Value > 0 Then
            Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C11")
        Else
            Set CCYO = CCYO & "_" & i = Sheets(nom).Range("C12")
        End If
     
        If Worksheets("2401").Range("H27").Value < 0 Then
            Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C12")
        Else
            Set CCYT = CCYT & "_" & i = Sheets(nom).Range("C11")
        End If
     
            Set RATE = RATE & "_" & i = Sheets(nom).Range("C13:D13")
     
    End With
       Next i
     
     
    '   Transfer PO data
     
     Dim intcount As Integer
        For intcount = 1 To 11
            For i = 1 To 10
                Select Case intcount
                Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
                Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
                Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
                Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
                Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
                Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
                Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
     
                        'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
     
                Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
     
                         'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
     
                Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
                Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
                Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
            End Select
            Next i
        Next intcount
     
    End Sub

Discussions similaires

  1. copier des cellules d'une feuille dans une autres sous condition
    Par olivertwist dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 16/05/2007, 10h42
  2. [PHP-JS] Actualisation d'une page sous condition
    Par oceane751 dans le forum Langage
    Réponses: 7
    Dernier message: 28/01/2007, 17h55
  3. [Excel] Calcul d'une somme sous condition
    Par netsabes dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 22/08/2006, 16h09
  4. Afficher une image sous condition
    Par Chmog dans le forum BIRT
    Réponses: 5
    Dernier message: 28/07/2006, 12h11
  5. Réponses: 8
    Dernier message: 14/01/2006, 15h17

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