Problème de recopie de lignes en vba

Version imprimable

Bonjour,

je cherche à recopie sur une feuille les lignes provenant de deux autres feuilles du classeur sous condition qu'elles contiennent deux valeurs communes (nom et date). Voilà le code que j'ai écrit et qui ne marche pas. Merci de m'aider.

Code:

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
 
Sub essai_doublons()
'ligat = nombre total de lignes du fichier "Actuel"
Dim ligat As Long
ligat = 0
While Worksheets("Actuel").Cells(ligat + 1, 1) <> ""
ligat = ligat + 1
Wend
'ligin = ligne du fichier "Import",
'coli = colonne du nom dans "Import"
Dim coli As Long
coli = 1
'colid = colonne de la date d’entrée dans "Import"
Dim colid As Long
colid = 2
'liga = ligne du fichier "Actuel"
'lcd = ligne courante dans "Doublons"
Dim ligin As Long, As Long, lcn As Long
ligin = 1
lcd = 1
lcn = 1
While Worksheets("Import").Cells(ligin, coli) <> ""
    For liga = 1 To ligat
    If Worksheets("Actuel").Cells(liga, 1) = Worksheets("Import").Cells(ligin, coli) And Worksheets("Actuel").Cells(liga, 6) = Worksheets("Import").Cells(ligin, colid) Then
    'recopie des lignes dans doublons et incrément de 2
    Worksheets("Import").Select
    Rows(liga).Select
    Selection.Copy
    Worksheets("Doublons").Select
    Rows(lcd).Insert
    Worksheets("Actuel").Select
    Rows(liga).Select
    Selection.Copy
    Worksheets("Doublons").Select
    Rows(lcd + 1).Insert
    lcd = lcd + 2
    End If
    Next liga
Wend
 
End Sub

bonjour,

tu devras travaillé avec des "tableau" (array) pour la vitesse d’exécution

mais pour tester,
1) trier par ordre alpha
2) tu lis dans une feuille (jusque à vide) et tu cherche dans l'autre feuille (jusque à vide)
3) tu écris la ou les lignes

pour les boucles,

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
for Boucle1 = FeuilleLireLigneDebut to FeuilleLireLigneFin
   if nom ="" then exit for  ---> on sort, on a fini
 
   for Boucle2 = FeuilleChercheLigneDebut to FeuilleChercheLigneFin
          if nom ="" then exit for  ---> pas trouvé  --> on sort, lire ligne suivante
          if nom = nom then 
 
                 TRAITEMENT
 
                 exit for  ---> trouvé  --> on sort, lire ligne suivante
           end if
   next Boucle2
next Boucle1

@+JP

17/05/2017, 14h47
Moa83

Question complémentaire

Débutant en VBA, je ne suis pas encore très familier avec les tableaux. Mais je vais essayer de voir cela. En revanche, mon problème est que la première ligne ne s'écrit pas dans ma feuille "Doublons" lorsque j'exécute, je n'ai que la deuxième. Y aurait-il une erreur de syntaxe?
17/05/2017, 14h52
mjpmjp

bonjour,

mets ton code...:whistle2:

@+JP

avec le code...

Code:

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
Sub essai_doublons()
'ligat = nombre total de lignes du fichier actuel
Dim ligat As Long
ligat = 0
While Worksheets("Actuel").Cells(ligat + 1, 1) <> ""
ligat = ligat + 1
Wend
'ligin = ligne du fichier import,
'coli = colonne du nom dans import
Dim coli As Long
coli = 1
'colid = colonne de la date d’entrée dans import
Dim colid As Long
colid = 6
'liga = ligne du fichier actuel
'lcd = ligne courante dans doublons
'lcn = ligne courante dans nouveau
Dim ligin As Long
'coli As Long, colid As Long,
Dim lcd As Long, lcn As Long
ligin = 1
lcd = 1
lcn = 1
While Worksheets("Import").Cells(ligin, coli) <> ""
    For liga = 1 To ligat
    If Worksheets("Actuel").Cells(liga, 1) = Worksheets("Import").Cells(ligin, coli) And Worksheets("Actuel").Cells(liga, 2) = Worksheets("Import").Cells(ligin, colid) Then
    'recopie des lignes dans doublons et incrément de 2
    Worksheets("Import").Select
    Rows(liga).Select
    Selection.Copy
    Worksheets("Doublons").Select
    Rows(3).Paste
    Worksheets("Actuel").Select
    Rows(liga).Select
    Selection.Copy
    Worksheets("Doublons").Select
    Rows(lcd + 1).Insert
    lcd = lcd + 2
    'else couper la ligne et coller dans nouveau et incrément de 1
    lcn = lcn + 1
    End If
    Next liga
    ligin = ligin + 1
Wend
 
End Sub

17/05/2017, 15h04
mjpmjp

bonjour,

celui là ...on le connait...c'est celui du début,
il a un problème de structure (organisation)

tu peux continuer avec While...Wend, do...loop, ... peu importe,

mais regarde le "plan" des boucles (plus haut) et surtout comment en sortir : exit While, exit do, ...

@+JP