Discussion :

[Invité]

Bonjour, voici mon premier message sur le site parce que je n'arrive pas à m'en sortir avec ces quelques lignes de codes, malgré toutes mes recherches... Merci par avance pour votre support!

J'essaie d'utiliser le code disponible ici : http://boisgontierjacques.free.fr/fi...000Lignes.xlsm pour réaliser une recherche matricielle entre 1 base de plus de 65000 lignes et plusieurs feuilles de plusieurs milliers de lignes que je souhaite importer une par une.

Or, à chaque import, toutes les cellules du champ résultat qui n'ont pas de clé correspondante dans la table source sont écrasées. J'aimerais conserver les données précédemment importées et donc que le code ignore les cellules non vides.

Sauriez-vous où insérer cette condition?
Merci!

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
 
Sub AppelSub()
  Set TableSource = Range("A2:B1200") ' champ table source
  Set ClésCherchées = Range("I2:I68000") ' champ des clés recherchées
  Set Résultat = Range("J2:J68000") ' champ résultat
  colResult = 2
  Rechv ClésCherchées, TableSource, 2, Résultat
End Sub
 
Sub Rechv(ClésCherchées, TableSource, colRésult, Résultat)
  Application.ScreenUpdating = False
  Set d = CreateObject("Scripting.Dictionary")
  a = TableSource.Value ' table source
  b = ClésCherchées.Value ' table des clés recherchées
  For i = LBound(a) To UBound(a)
    d(a(i, 1)) = a(i, colRésult)
  Next i
  Dim temp()
  ReDim temp(LBound(b) To UBound(b), 1 To 1)
  For i = LBound(b) To UBound(b)
    If d(b(i, 1)) <> "" Then temp(i, 1) = d(b(i, 1)) Else temp(i, 1) = ""
  Next i
  Résultat.Value = temp
End Sub

[Philippe Tulliez]

Bonjour,
Pourquoi ne t'adresses-tu pas directement à l'auteur lui-même ?

[Invité]

Bonjour,
Bonne remarque! Mais je n'ai pas trouvé de moyen de la contacter via son site... C'est pour cela que je tente le forum. :-)

[Invité]

Bonjour à tous,

Le principe est de conserver la colonne J en synthèse des résultats et de mémoriser ou non les résultats dans les colonnes suivantes.

J'aurais vu un truc comme ça :
Nb : Je me suis permis de typer et de modifier le nom des variables (pas de caractères accentués).

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
Sub AppelSub()
 
Dim Reponse As Integer
 
Dim ColResult As Long
Dim ColonneCles As Long
Dim ColonneResultat As Long
Dim ColonneSyntheseResultat As Long
 
Dim TableSource As Range
Dim ClesCherchees As Range
Dim Resultat As Range
Dim CelluleResultat As Range
 
  With ActiveSheet
 
       ColonneCles = 9
       ColonneSyntheseResultat = ColonneCles + 1                 ' La colonne J sert à mémoriser les résultats
       .Cells(1, ColonneSyntheseResultat) = "Synthèse résultats" ' Au cas où cette cellule serait vide
 
       ColonneResultat = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
       With .Cells(1, ColonneResultat)
            .Value = "Calcul du " & Date  ' En admettant que les calculs soient datés en ligne 1 après la colonne synthèse
            .WrapText = True
       End With
 
       Set TableSource = .Range("A2:B1200")                                  ' champ table source
       Set ClesCherchees = .Range("I2:I68000")                               ' champ des clés recherchées
       Set Resultat = ClesCherchees.Offset(0, ColonneResultat - ColonneCles) ' champ résultat
       ColResult = 2
 
       Rechv ClesCherchees, TableSource, 2, Resultat
 
 
       ' Mémorisation du résultat dans la colonne synthèse si la cellule synthèse est vide.
       For Each CelluleResultat In Resultat
           If CelluleResultat <> "" And CelluleResultat.Offset(0, ColonneSyntheseResultat - ColonneResultat) = "" Then
              CelluleResultat.Offset(0, ColonneSyntheseResultat - ColonneResultat) = CelluleResultat
           End If
       Next CelluleResultat
 
       ' On garde la trace du résultat ou non
       Reponse = MsgBox("Voulez-vous effacer la colonne résultat ?", vbYesNo)
       If Reponse = 6 Then Resultat.Clear
 
       Set TableSource = Nothing
       Set ClesCherchees = Nothing
       Set Resultat = Nothing
 
  End With
 
End Sub

Cordialement.