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 :

Fusion de 2 worksheet_Change


Sujet :

Macros et VBA Excel

  1. #1
    Membre confirmé
    Inscrit en
    Décembre 2010
    Messages
    139
    Détails du profil
    Informations forums :
    Inscription : Décembre 2010
    Messages : 139
    Par défaut Fusion de 2 worksheet_Change
    Bonjour

    Besoin d'aide pour fusionner 2 codes

    Le code suivant fonctionne très bien, il valide la valeur de la cellule B1 dans la colonne A d'une autre feuille et retourne toute les valeur inscrite en G

    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
    Private Sub Worksheet_Change(ByVal Target As Range)
     
        Dim iLigFin As Integer
        Dim iLig As Integer
        Dim iEcr As Integer
     
     
        If Target.Count = 1 Then
            If Target.AddressLocal = "$B$1" Then
                iLigFin = Range("a" & Rows.Count).End(xlUp).Row
                If iLigFin >= 7 Then
                    Range("a8:a" & iLigFin).ClearContents
                End If
     
                iEcr = 7
                iLigFin = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
                For iLig = 2 To iLigFin
                    If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then
                        Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value
                        iEcr = iEcr + 1
                    End If
                Next iLig
           End if
     End if
    End sub
    1 ière question, comment supprimer les doublons de ce résultat

    Autre point, je voudrais ajouter au code qu'il retourne également les valeurs inscrites en AL

    Comment ajouter

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    If Target.AddressLocal = "$b$1" Then
                iLigFin = Range("b" & Rows.Count).End(xlUp).Row
                If iLigFin >= 29 Then
                    Range("b29:b" & iLigFin).ClearContents
                End If
     
                iEcr = 29
                iLigFin = Sheets("Facturation_Détaillée").Range("al" & Rows.Count).End(xlUp).Row
                For iLig = 2 To iLigFin
                    If Sheets("Facturation_Détaillée").Range("al" & iLig).Value = Target.Value Then
                        Range("al" & iEcr).Value = Sheets("Facturation_Détaillée").Range("al" & iLig).Value
                        iEcr = iEcr + 1
    Merci

  2. #2
    Membre confirmé
    Inscrit en
    Décembre 2010
    Messages
    139
    Détails du profil
    Informations forums :
    Inscription : Décembre 2010
    Messages : 139
    Par défaut
    Bonjour

    J'ai réussi a fusionner les codes

    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
    Private Sub Worksheet_Change(ByVal Target As Range)
     
        Dim iLigFin As Integer
        Dim iLig As Integer
        Dim iEcr As Integer
        Dim iLigFin2 As Integer
        Dim iLig2 As Integer
        Dim iEcr2 As Integer
     
     
        If Target.Count = 1 Then
            If Target.AddressLocal = "$B$1" Then
                iLigFin = Range("a" & Rows.Count).End(xlUp).Row
                iLigFin2 = Range("b" & Rows.Count).End(xlUp).Row
                If iLigFin >= 7 Then
                    Range("a8:a" & iLigFin).ClearContents
                End If
                If iLigFin2 >= 30 Then
                    Range("b29:b" & iLigFin2).ClearContents
                End If
     
                iEcr = 7
                iLigFin = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
     
                iEcr2 = 29
                iLigFin2 = Sheets("Facturation_Détaillée").Range("A" & Rows.Count).End(xlUp).Row
     
     
                For iLig = 2 To iLigFin
                    If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then
                        Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value
                        iEcr = iEcr + 1
                    End If
                Next iLig
     
                For iLig2 = 2 To iLigFin2
                    If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then
                        Range("b" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value
                        iEcr2 = iEcr2 + 1
                    End If
                Next iLig2
     
            End If
      End If
     
    End Sub
    Par contre comment supprimer les doublons du résultat de la colonne A et les cellules "vide" de AL

    Merci

  3. #3
    Membre confirmé
    Inscrit en
    Décembre 2010
    Messages
    139
    Détails du profil
    Informations forums :
    Inscription : Décembre 2010
    Messages : 139
    Par défaut
    Pour les intéressés

    J'ai réussis à supprimer les doublons du résultat retourné dans la colonne A

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    For iLig = 2 To iLigFin
                    If Sheets("Facturation_Détaillée").Range("A" & iLig).Value = Target.Value Then
                        Range("A" & iEcr).Value = Sheets("Facturation_Détaillée").Range("G" & iLig).Value
                        Sheets("Facture").Range("a1:a75").RemoveDuplicates Columns:=1, Header:=xlNo
                        iEcr = iEcr + 1
                    End If
                Next iLig

    Mais cherche toujours à ce que les cellules vides (AL = "")ne soient pas retournées dans le résultat voulu à la colonne B

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    For iLig2 = 2 To iLigFin2
                    If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then
                        Range("b" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value
                        iEcr2 = iEcr2 + 1
                    End If
                Next iLig2
    Merci de m'aider

  4. #4
    Membre confirmé
    Inscrit en
    Décembre 2010
    Messages
    139
    Détails du profil
    Informations forums :
    Inscription : Décembre 2010
    Messages : 139
    Par défaut
    Pour les intéressés

    J'ai trouvé + également ajouté une mise en forme

    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
     For iLig2 = 2 To iLigFin2
                    If Sheets("Facturation_Détaillée").Range("A" & iLig2).Value = Target.Value Then
                        Range("b" & iEcr2).Value = Sheets("Facturation_Détaillée").Range("al" & iLig2).Value
                        iEcr2 = iEcr2 + 1
                        Sheets("Facture").Range("b29:b100").SpecialCells(xlCellTypeBlanks).Delete xlUp
                            Range("B29:b100").Select
                                With Selection.Font
                                .Name = "Calibri"
                                .Size = 10
                                End With
                                With Selection
                                    .HorizontalAlignment = xlRight
                                    .VerticalAlignment = xlBottom
                                End With
                    End If
                Next iLig2

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

Discussions similaires

  1. [VBA-E] Fusion de cellule
    Par Nicos77 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 29/07/2004, 13h24
  2. Fusion de lignes de tables en éliminant les redondances
    Par MinsK dans le forum Algorithmes et structures de données
    Réponses: 12
    Dernier message: 22/04/2004, 09h21
  3. [MFC]Info sur da la fusion sous Word
    Par kor dans le forum MFC
    Réponses: 6
    Dernier message: 22/08/2003, 11h14
  4. Fusion directe dans word
    Par wozzy dans le forum Access
    Réponses: 10
    Dernier message: 03/06/2003, 21h02
  5. Tri par fusion d'un tableau
    Par Mailgifson dans le forum C
    Réponses: 5
    Dernier message: 12/12/2002, 14h53

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