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 :

ligne de renvoi d'une rechercheV


Sujet :

Macros et VBA Excel

  1. #1
    Membre confirmé
    Homme Profil pro
    Inscrit en
    Juin 2012
    Messages
    63
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Secteur : Finance

    Informations forums :
    Inscription : Juin 2012
    Messages : 63
    Par défaut ligne de renvoi d'une rechercheV
    Bonjour,

    je cherche en vain le moyen de choisir la ligne de renvoi d'une rechercheV; je m'explique :

    j'ai un beau tableau avec des numéros clients, mais pour certains j'ai deux ou trois lignes de suite avec les mêmes clients (donc même numéro client...)

    mon petit bout de code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Sub rib()
    Dim i As Integer
     
    Sheets("prel").Activate
    Range("a2").Select
    Range(Selection, Selection.End(xlDown)).Select
    i = Selection.Rows.Count
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],'FICHIER GAL'!R1C2:R3000C7,6,0) & ""-"" & VLOOKUP(RC[-8],'FICHIER GAL'!R1C2:R3000C4,3,0)"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
    Cela rapellera peut-être quelquechose à certains aujourd'hui
    Dans mes rechercheV, j'aimerai savoir s'il est possible de choisir la ligne du FICHIER GAL qui sera renvoyée...??

    Merci d'avance

  2. #2
    Membre Expert
    Homme Profil pro
    Retraité
    Inscrit en
    Avril 2011
    Messages
    1 858
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : Avril 2011
    Messages : 1 858
    Par défaut
    Bonsoir,

    Si tu as plusieurs lignes avec les mêmes clients et que tu penses pouvoir choisir la ligne du FICHIER GAL qui sera renvoyée, c’est sûrement que tu as défini un critère supplémentaire pour ce choix.
    Mais cela n’apparait pas dans ton code.

    Cordialement.

  3. #3
    Membre confirmé
    Homme Profil pro
    Inscrit en
    Juin 2012
    Messages
    63
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Secteur : Finance

    Informations forums :
    Inscription : Juin 2012
    Messages : 63
    Par défaut
    En fait non...
    il s'agit d'avoir un bordereau (sheets"prel") avec une seule ligne de prelevement pour chaque client du FICHIER GAL qui cumule deux montant (voir plus).
    Au bout de cette ligne unique de ma feuille "prel" j'aimerai qu'il me renvoi le détail de chaque montant et le numéro d'opération qu va avec (la double rechercheV), qu'il va donc chercher dans le FICHIER GAL en fonction du code client, qui est mon seul critère de recherche...

  4. #4
    Membre Expert
    Homme Profil pro
    Retraité
    Inscrit en
    Avril 2011
    Messages
    1 858
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : Avril 2011
    Messages : 1 858
    Par défaut
    Si je comprends bien ....
    Dans la feuille FICHIER GAL, tu peux avoir plusieurs lignes pour un même client.
    Dans chacune de ces lignes, il y a un montant (on ne sait pas où).
    Tu veux reporter ces montants (sous quelle forme ?) dans la feuille "prel" afin d’avoir une seule ligne par client.

  5. #5
    Membre confirmé
    Homme Profil pro
    Inscrit en
    Juin 2012
    Messages
    63
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Secteur : Finance

    Informations forums :
    Inscription : Juin 2012
    Messages : 63
    Par défaut
    Avec le fichier en PJ ça devrait être plus explicite

    et voici le 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
    Sub Test()
    Dim DateDeb As Date, DateFin As Date
    Dim Cellule As Range, Plage As Range
    Dim Rechercheplage As String
        Set Plage = Application.InputBox("saisir i2:i3000", "Choix de la plage", Type:=8)
        Rechercheplage = InputBox("respecter le format majuscule-espace-date exemple AU 05", "Entrer la date d'echeance à rechercher")
        If Rechercheplage = vbNullString Then Exit Sub
            For Each Cellule In Plage
                If InStr(1, Cellule.Value, Rechercheplage) > 0 Then
                    Range(Cellule.Address).Select
                    DateDeb = ActiveCell.Offset(0, -4)
                    DateFin = ActiveCell.Offset(0, -3)
                    If (DateDeb <= Date And DateFin >= Date) Then
                        ActiveCell.Offset(0, -7).Copy Sheets("prel").Cells(65535, 1).End(xlUp)(2)
                        ActiveCell.Offset(0, -5).Copy Sheets("prel").Cells(65535, 2).End(xlUp)(2)
                        ActiveCell.Offset(0, -8).Copy Sheets("prel").Cells(65535, 3).End(xlUp)(2)
                        End If
                End If
            Next
    supprimeDoublons
    rib
    End Sub
     
    Private Sub supprimeDoublons()
     
    Sheets("prel").Activate
    MaCellule = ("C2")
    Range(MaCellule).Select
    donnee1 = ActiveCell
    ActiveCell.Offset(1, 0).Select
     
    While ActiveCell <> ""
    If ActiveCell = donnee1 Then
    ActiveCell.Offset(-1, -1) = (ActiveCell.Offset(-1, -1) + ActiveCell.Offset(0, -1))
    ActiveCell.EntireRow.Delete
    ActiveCell.Offset(-1, 0).Select
    donnee1 = ActiveCell
    ActiveCell.Offset(1, 0).Select
    Else
    donnee1 = ActiveCell
    ActiveCell.Offset(1, 0).Select
    End If
    Wend
    End Sub
     
    Private Sub rib()
    Dim i As Integer, k As Integer
     
    Sheets("prel").Activate
    Range("a2").Select
    Range(Selection, Selection.End(xlDown)).Select
    i = Selection.Rows.Count
    Range("d2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],rib1!R1C1:R300C4,4,0)"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],rib1!R1C1:R300C5,5,0)"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-5],rib1!R1C1:R300C6,6,0)"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6],rib1!R1C1:R300C7,7,0)"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7],rib1!R1C1:R300C8,8,0)"
    Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
    'Range("I2").Select
    'ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8],'FICHIER GAL'!R1C2:R3000C7,6,0) & ""-"" & VLOOKUP(RC[-8],'FICHIER GAL'!R1C2:R3000C4,3,0)"
    'Selection.AutoFill Destination:=ActiveCell.Range("A1:A" & i)
    'OU For k = ActiveCell To i
       Columns("B:B").ColumnWidth = 12
        Columns("C:C").ColumnWidth = 30
        Columns("D:D").ColumnWidth = 36.57
        Columns("E:E").Select
            With Selection
                .ColumnWidth = 9.57
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        Columns("F:F").Select
            With Selection
                .ColumnWidth = 10.57
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        Columns("G:G").Select
            With Selection
                .ColumnWidth = 12.29
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        Columns("H:H").Select
            With Selection
                .ColumnWidth = 5.86
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
    Calculate
     
    End Sub
    En grisé mes essais pour renvoyé sur la feuille "prel" en i2 et j2 les info de la feuille FICHIER GAL (colonnes D-G)
    donc si sur la feuille FICHIER GAL j'ai 2 lignes pr le même client (ligne x et y), il me faut sur la feuille "prel" en i2 => Dx-Gx et et en j2 =>Dy-Gy

    Et là je ne vois pas!!!
    Fichiers attachés Fichiers attachés

  6. #6
    Membre Expert
    Homme Profil pro
    Retraité
    Inscrit en
    Avril 2011
    Messages
    1 858
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : Avril 2011
    Messages : 1 858
    Par défaut
    Bonjour,

    Une solution sans utilisation de formules
    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
    Private Sub rib()
    Dim i As Integer, k As Integer
    Dim DerLig As Long
    Dim WsGAL As Worksheet, WsRIB As Worksheet
    Dim PlageRechercheRIB As Range, PlageRechercheGAL As Range, Cel As Range, C As Range
    Dim firstAddress As String
        Set WsGAL = Worksheets("FICHIER GAL")
        Set WsRIB = Worksheets("rib1")
        With Worksheets("prel")
            'Recherche du dernier N° client renseigné dans "prel"
            DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
     
            'Définition de la plage de recherche dans rib1
            Set PlageRechercheRIB = WsRIB.Range("A2:H" & WsRIB.Range("A" & WsRIB.Rows.Count).End(xlUp).Row)
     
            'Recherche du n° client dans rib1 et recopie des données dans prel
            For Each Cel In .Range("A2:A" & DerLig)
     
                'Domiciliation banque
                .Range("D" & Cel.Row) = Application.VLookup(Cel.Value, PlageRechercheRIB, 4, 0)
                'Code banque
                .Range("E" & Cel.Row) = Application.VLookup(Cel.Value, PlageRechercheRIB, 5, 0)
                'Guichet
                .Range("F" & Cel.Row) = Application.VLookup(Cel.Value, PlageRechercheRIB, 6, 0)
                'Compte
                .Range("G" & Cel.Row) = Application.VLookup(Cel.Value, PlageRechercheRIB, 7, 0)
                'Cle
                .Range("H" & Cel.Row) = Application.VLookup(Cel.Value, PlageRechercheRIB, 8, 0)
     
                'Définition de la plage de recherche dans FICHIER GAL
                Set PlageRechercheGAL = WsGAL.Range("B2:B" & WsGAL.Range("B" & WsGAL.Rows.Count).End(xlUp).Row)
     
                Set C = WsGAL.Range("B1:B3000").Find(Cel.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not C Is Nothing Then
                    k = 8
                    firstAddress = C.Address
                    Do
                        Cel.Offset(0, k) = C.Offset(0, 5) & "-" & C.Offset(0, 2)
                        k = k + 1
                        Set C = WsGAL.Range("B1:B3000").FindNext(C)
                    Loop While Not C Is Nothing And C.Address <> firstAddress
                End If
     
            Next Cel
     
            .Columns("B:B").ColumnWidth = 12
            .Columns("C:C").ColumnWidth = 30
            .Columns("D:D").ColumnWidth = 36.57
            With .Columns("E:E")
                .ColumnWidth = 9.57
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With .Columns("F:F")
                .ColumnWidth = 10.57
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With .Columns("G:G")
                .ColumnWidth = 12.29
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            With .Columns("H:H")
                .ColumnWidth = 5.86
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
        End With
    End Sub
    Cordialement.

  7. #7
    Membre confirmé
    Homme Profil pro
    Inscrit en
    Juin 2012
    Messages
    63
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Secteur : Finance

    Informations forums :
    Inscription : Juin 2012
    Messages : 63
    Par défaut
    Mille merci c'est exactement ce dont j'ai besoin

    Juste une chose, comment afficher le résultat
    il me faut sur la feuille "prel" en i2 => Dx-Gx et et en j2 =>Dy-Gy
    uniquement si sur le FICHIER GAL
    colonnes
    Ex <= date <= Fx

    un peu comme au début de la macro
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    DateDeb = ActiveCell.Offset(0, -4)
    DateFin = ActiveCell.Offset(0, -3)
    If (DateDeb <= Date And DateFin >= Date) Then
    ?

  8. #8
    Membre Expert
    Homme Profil pro
    Retraité
    Inscrit en
    Avril 2011
    Messages
    1 858
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Retraité

    Informations forums :
    Inscription : Avril 2011
    Messages : 1 858
    Par défaut
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
                    Do
                        If C.Offset(0, 3) <= Date And C.Offset(0, 4) >= Date Then
                            Cel.Offset(0, k) = C.Offset(0, 5) & "-" & C.Offset(0, 2)
                            k = k + 1
                        End If
                        Set C = WsGAL.Range("B1:B3000").FindNext(C)
                    Loop While Not C Is Nothing And C.Address <> firstAddress
    Cordialement.

  9. #9
    Membre confirmé
    Homme Profil pro
    Inscrit en
    Juin 2012
    Messages
    63
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Secteur : Finance

    Informations forums :
    Inscription : Juin 2012
    Messages : 63
    Par défaut


    ça fonctionne parfaitement

    Merci bcp

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 7
    Dernier message: 11/11/2014, 23h40
  2. Comment faire pour qu'une vue renvoie toujours une ligne
    Par jfouche dans le forum Langage SQL
    Réponses: 4
    Dernier message: 12/10/2009, 10h01
  3. Concaténer des lignes d'enregistrements dans une colonne
    Par dany13 dans le forum MS SQL Server
    Réponses: 10
    Dernier message: 08/07/2005, 21h56
  4. selectionner une ligne au hasard dans une table
    Par dark_vidor dans le forum Requêtes
    Réponses: 2
    Dernier message: 27/06/2005, 12h01
  5. Comment mettre des lignes de couleur dans une TCheckListBox ?
    Par Isa31 dans le forum Composants VCL
    Réponses: 9
    Dernier message: 31/03/2005, 08h40

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