Discussion :

[Nonouf]

Bonjour à tous,


Utilisateur plutôt débutant d'Excel VBA, je pianote beaucoup sur ce logiciel par plaisir.
Je consulte depuis longtemps ce forum et je viens de m'inscrire car je ne trouve pas de réponse à mon problème.

Voici mon problème :

J'ai un premier onglet que j'appelle "à intégrer" dans lequel se trouve un tableau de 8 colonnes (de A à H).
Ce tableau peut avoir jusqu'à une trentaine de ligne.
Il s'agit d'une feuille dans laquelle arrivent des données issues d'un fichier txt.

Dans mon deuxième onglet que j'appelle "Data" , j'ai le même tableau avec d'autres données et une colonne supplémentaire en I qui contient du numérique.

Ce que je cherche à faire via VBA :

Intégrer les lignes de l'onglet "à intégrer" dans l'onglet "Data" en m'assurant avant qu'il n'existe pas déjà dans l'onglet "Data" une ligne comportant les mêmes valeurs en colonnes B, C, E, G et H.
Si une ligne existe déjà avec les mêmes valeurs dans ces colonnes, je dois alors incrémenter la colonne I (valeur numérique) de cette ligne de +1.
Si aucune ligne ne correspond, je dois alors ajouter cette ligne dans l'onglet "Data" avec la valeur 1 en colonne I.


Voià voilà, j'espère que ce problème donnera du plaisir aux plus expérimentés


Merci à vous.
Nonouf

[Invité]

Bonsoir,
regarde ça : http://www.developpez.net/forums/d13...-via-userform/

[eric4459]

Bonsoir
Essayes ceci, j'ai écrit cela en vitesse pour les colonnes B et C, tu devras adapter ensuite.

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
Sub A_INTEGRER()
 
 
Dim Base As Worksheet
Dim data As Worksheet
Dim BL As Range
Dim ACVAL As Range
Dim i As Integer
Set Base = ThisWorkbook.Sheets("à intégrer")
Set data = ThisWorkbook.Sheets("Data")
Set BL = Base.Range(" B1")
BL = BL.Offset(0)
Set ACVAL = data.Range("B1")
ACVAL = ACVAL.Offset(0)
 
For i = 0 To 30
If BL.Offset(i, 0) & BL.Offset(i, 1) = ACVAL.Offset(i, 0) & ACVAL.Offset(i, 1) Then
ACVAL.Offset(i, 8) = ACVAL.Offset(i, 8) + 1
Else
ACVAL.Offset(i + 1, 0) = BL.Offset(i, 0)
ACVAL.Offset(i + 1, 1) = BL.Offset(i, 1)
End If
i = i + 1
Next i
 
End Sub

Eric

[Marc-L]

Bonsoir !

Nonouf, j'ai une manière efficiente et particulière de le faire (peu de lignes de code),
déjà exposée avec succès sur un forum étranger mais pas encore sur celui-ci !
C'est en fait une variante de l'utilisation d'un objet connu mais via une propriété non documentée officiellement,
du moins à l'époque. J'attendais un cas concret pour poster une contribution …

Cependant j'aurais besoin de connaitre la version d'Excel - devant pourtant être indiquée dans le titre de la discussion
(conformément aux règles du forum !) - et si c'est bien sous Windows
(pour Mac c'est mort ! Quoique j'ai sous le coude une autre méthode un peu mois rapide mais convenable …)
ainsi qu'un classeur xlsx (sans code) comportant les feuilles sources et une feuille résultat désiré.

[Nonouf]

Bonjour,

Merci pour ces premières contributions

A rdurupt :
Je crois que je n'ai pas le niveau pour adapter ton code

A Eric :
C'est un peu plus à ma portée, je vais faire des essais, ca m'a donné des idées.

A Marc :
Ca m'intérèsse !

Je vous joins un fichier exemple comme demandé.
Dans l'onglet résultat, j'ai mis les changements en rouge.
A la fin du traitement, la feuille A INTEGRER est de nouveau vierge.
Je suis sous Win 7 et Excel 2010.


Merci à vous.
Nonouf

[Invité]

la solution que tu cherche est dans les exemples!

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
Sub test()
Dim Init As Boolean
Dim DerL As Long
'***************************************************
'Vérification de l'existant avant import CSV
Init = False
Set MyRange = Sheets("Feuil1").UsedRange
Debug.Print "********************"
Debug.Print "Sur la ligne"
For L = 1 To MyRange.Rows.Count
    Debug.Print Highlander(Init, MyRange.Range(MyRange(L, 1), MyRange(L, MyRange.Columns.Count)))
Next
 
Set MyRange = Sheets("Feuil2").UsedRange
Debug.Print "********************"
Debug.Print "Sur la ligne"
For L = 1 To MyRange.Rows.Count
   If Highlander(Init, MyRange.Range(MyRange(L, 1), MyRange(L, MyRange.Columns.Count))) = False Then
  DerL = Sheets("Feuil1").Cells(Sheets("Feuil1").Cells.Rows.Count, 1).End(xlUp).Row + 1
    MyRange.Range(MyRange(L, 1), MyRange(L, MyRange.Columns.Count)).Copy Sheets("Feuil1").Cells(DerL, 1)
   End If
Next
 
End Sub
 
Function Highlander(Init As Boolean, ParamArray Plage()) As Boolean
'..................................................
'La méthode Highlander, il ne peut en rester qu'un.
'Retourne True si doublon.
'..................................................
 
Static CollectDoublon As Collection
Dim T As String
Dim PlageIndex As Long
Dim myPlage As Range
Dim Col As Integer
Dim Tableau
If Init = False Then
Init = True
   Set CollectDoublon = Nothing
   Set CollectDoublon = New Collection
End If
 
 
T = "T"
For PlageIndex = 0 To UBound(Plage)
If TypeName(Plage(PlageIndex)) = "Range" Then
       Set myPlage = Plage(PlageIndex)
 
       For Col = 1 To myPlage.Columns.Count
        T = T & "_" & Trim("" & myPlage(1, Col))
       Next
    Else
        If TypeName(Plage(PlageIndex)) = "Variant()" Then
           Tableau = Plage(PlageIndex)
        Else
            If TypeName(Plage(PlageIndex)) Like "*()" Then
                Tableau = Plage(PlageIndex)
            Else
                Tableau = Split(Plage(PlageIndex) & ";", ";")
            End If
        End If
         For Col = 0 To UBound(Tableau)
           If Trim("" & Tableau(Col)) <> "" Then T = T & "_" & Trim("" & Tableau(Col))
         Next
    End If
Next
On Error Resume Next
CollectDoublon.Add T, T
If Err <> 0 Then Highlander = True
On Error GoTo 0
End Function

la méthode Highlander tu n'y touche pas tu l'utilise c'est tout!

[Marc-L]

L'astuce évoquée serait un peu too much dans ce cas car une clef sur l'immatriculation - unique donc - est suffisante !

Par contre dans la feuille A INTEGRER il n'y a pas de corrélation pour la première ligne (Nissan) avec la feuille DATA,
juste une erreur dans ce fichier exemple fait à la va-vite ?

Sinon en utilisant les fonctions de feuilles de calculs, le code serait plus simple que le post #6 …
La méthode RemoveDuplicates ne convient pas car il ne s'agit pas d'une simple copie !