Recherche puis copie Vba

Calvus

XLDnaute Barbatruc
Bonjour,

J'ai une macro dont le but est de chercher si une valeur existe.
Si tel n'est pas le cas alors la copie se fait en dernière ligne.

VB:
Sub copie()
Dim i As Integer, var1 As String
var1 = [E1].Value
For i = 3 To Range("A1000").End(xlUp)
    If Not Range("A" & i) Like var1 Then
    Range("A1000").End(xlUp).Rows(2) = var1
    End If
Next
End Sub

2 questions :

1/ Si la colonne A ne contient pas de donnée numérique, alors j'obtiens une erreur (incompatibilité de type 13)
Pourquoi ?
(Je n'ai pas cette erreur si la recherche se fait dans un autre classeur à partir de celui-ci !!)

2/ Une fois Var1 copiée, comment arrêter la boucle ? En effet la valeur s'inscrit autant de fois qu'il y a de lignes, ce qui ne me convient évidemment pas.

Je précise que la suite de la macro devra faire une recherche pour les autres colonnes également, jusqu'à la colonne K

Merci de votre aide.
 

Pièces jointes

  • Recherche Like.xlsm
    15.9 KB · Affichages: 30

thebenoit59

XLDnaute Accro
Re : Recherche puis copie Vba

Bonjour Calvus.

1) En effet tu obtiens une erreur car dans ton code tu écris :
Code:
Range("A1000").End(xlUp)
Cela renvoie la valeur de la dernière ligne, et non pas le numéro de la ligne.
Code:
Range("A1000").End(xlUp).Row
Et cela résout le problème

2) Tu boucles tes recherches sur chaque cellule, il va donc inscrire var1 pour chaque cellule ne le contenant pas.
Dans ton exemples, il ne trouve pas var1 trois fois, il l'inscrit donc trois fois.

Je te propose :
Code:
Sub copie()
Dim var1 As String, ligne As Long
ligne = Cells(Rows.Count, 1).End(xlUp).Row
var1 = [E1].Value
    Set C = Range("A" & ligne).Find(var1, LookIn:=xlValues, lookat:=xlWhole)
        If C Is Nothing Then Range("A1000").End(xlUp).Rows(2) = var1
End Sub
 

Paf

XLDnaute Barbatruc
Re : Recherche puis copie Vba

bonjour Calvus, thebenoit59,


une autre solution avec prise en compte colonnes E à K

Code:
Sub Copie2()
 Dim j As Integer, var1 As String, DerL As Long, Trouve As Range
 With Worksheets("Feuil1")
 For j = 5 To 11 'pour les colonnes 5 (E) à 11 (K)
    var1 = .Cells(1, j).Value
    DerL = .Range("A" & Rows.Count).End(xlUp).Row
    Set Trouve = .Range("A3:A" & DerL).Find(var1)
    If Trouve Is Nothing Then .Cells(DerL + 1, 1) = var1
 Next
 End With
End Sub

A+
 

Calvus

XLDnaute Barbatruc
Re : Recherche puis copie Vba

Bonsoir thebenoit59, Paf,

Merci de vos réponses.

@thebenoit59 : Pour la question 1, merci, résolu. J'avais bien formulé le code pourtant dans mon classeur original, et ai oublié le .Row en faisant l'exemple. C'est pourquoi ça fonctionnait avec l'autre classeur. Des fois on n'a vraiment pas les yeux en face des trous !
Concernant ton code pour la question 2, ça ne fonctionne pas. Ça fonctionne si je mets : If Not(C) Is Nothing, mais la valeur s'inscrit autant de fois que la macro est lancée, ce qui n'est évidemment pas une solution satisfaisante.

@Paf : Ton code fonctionne, mais (encore un mais :) ), tout s'inscrit en colonne A. Or j'ai besoin de chercher les valeurs dans chaque colonne, et les y inscrire si elles n'y figurent pas.
J'ai donc adapté ton code comme suit :

VB:
Sub copie()
    Dim i As Integer, var1 As String
ligne = Cells(Rows.Count, 1).End(xlUp).Row
var1 = [E1].Value
var2 = [F1].Value
    DerL = Range("A" & Rows.Count).End(xlUp).Row
    DerL2 = Range("B" & Rows.Count).End(xlUp).Row
    For i = 3 To Range("A1000").End(xlUp).Row
    For j = 3 To Range("B1000").End(xlUp).Row
    Set Trouve = Range("A3:A" & DerL).Find(var1)
    Set Trouve2 = Range("B3:B" & DerL2).Find(var2)
    If Trouve Is Nothing Then Cells(DerL + 1, 1) = var1
    If Trouve2 Is Nothing Then Cells(DerL2 + 1, 2) = var2

'Range("A1000").End(xlUp).Rows(2) = var1
    '[c2].Select
Next
Next
End Sub

Ça risque d'être un peu long en revanche pour les 11 colonnes....me retrouver avec DerL11 et Trouve11...

Mais en attendant un éclairage de votre part...

Je voulais d'ores et déjà vous répondre et vous remercier de m'avoir remis sur la voie.

Bonne nuit.
 

thebenoit59

XLDnaute Accro
Re : Recherche puis copie Vba

Bonjour Calvus.

Je ne comprends pas pourquoi, sur ton fichier, tu as du rajouter le Not à If C Is Nothing.
Cela fonctionne parfaitement sans et ça évite que ça se rajoute si la valeur existe déjà.

Pour améliorer ton fichier, je peux te proposer d'enregistrer les valeurs que tu souhaites rechercher dans un tableau.
Puis de boucler chaque colonne, et dans chaque colonne chaque valeur du tableau.
Il y a sans doute moyen de l'optimiser, mais l'avantage est que tu n'as pas besoin de créer une variable de dernière ligne par colonne, et par valeur recherchée.

Code:
Sub test()
'Déclaration des variables
Dim tableau1() As String, DerLig As Long, Resultat As String, ZoneRecherche As Range

'Alimentation du tableau
ReDim tableau1(0 To 2)
For i = 0 To 2 '0 est la première ligne du tableau, 7 la dernière
    tableau1(i) = Cells(1, i + 5)
Next i

'Recherche dans colonne (de A (1) jusqu'à K (11))
For j = 1 To 11
    DerLig = Cells(Rows.Count, j).End(xlUp).Row 'On trouve la dernière ligne de la colonne j
    Set ZoneRecherche = Range(Cells(3, j), Cells(DerLig, j)) 'On définit la zone de recherche
        For i = 0 To 2 'On boucle toutes les valeurs du tableau
            Set c1 = ZoneRecherche.Find(tableau1(i), LookIn:=xlValues, LookAt:=xlWhole)
                If c1 Is Nothing Then
                    Cells(DerLig + 1, j) = tableau1(i)
                    DerLig = DerLig + 1
                End If
        Next i
Next j
End Sub
 

Calvus

XLDnaute Barbatruc
Re : Recherche puis copie Vba

Bonjouthebenoit59,

Désolé, tu as raison. Je n'aurais pas dû faire ça à 1h du mat. Ta solution fonctionne en effet. J’accumule les bêtises en ce moment moi.
J'avais copié ta macro sous la mienne, et manifestement lancé la mienne....:confused:

Par contre, pour le tableau, ça remplit toutes les colonnes avec les valeurs sélectionnées. Or j'ai besoin de remplir si et seulement si une variable est choisie.

Voir l'illustration.

Recherche Like.jpg

Merci

Ps : j'espère que c'est sans bêtises maintenant ;)
 

Si...

XLDnaute Barbatruc
Re : Recherche puis copie Vba

salut

un essai avec les informations glanées ici et là mais ce sera tout*.
Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If Intersect(R, [E1:K1]) Is Nothing Then Exit Sub 'K ou plus loin et pour 1 choix à la fois
   If Columns(R.Column - 4).Find(R) Is Nothing Then Cells(65000, R.Column - 4).End(xlUp)(2) = R
End Sub

* On ne le dira jamais assez :
Un petit fichier avec mise en évidence des données connues et de celles à trouver peut aider à mieux te guider.
 

Pièces jointes

  • Copie de Recherche.xlsm
    34.7 KB · Affichages: 21
  • Copie de Recherche.xlsm
    34.7 KB · Affichages: 20

Calvus

XLDnaute Barbatruc
Re : Recherche puis copie Vba

Re,

@thebenoit59 : oui

@ Si : Trop sort le Fi !

Les variables ne sont pas dans ce classeur, mais dans un autre, et il n'y a pas d’ordonnancement particulier. C'est pour ça que le code proposé en #4 fonctionne bien. Le seul problème en étant la longueur comme je l'ai dit.
Exemple, les valeurs pourraient être :
var1 = [E1].Value
var2 = [F1].Value
var3 = [G8].Value
var4 = [A3].Value
Etc...

Ce n'est pas grave s'il n'y a pas mieux.

Merci et bonne soirée
 

Discussions similaires

Réponses
7
Affichages
235

Statistiques des forums

Discussions
312 493
Messages
2 088 955
Membres
103 989
dernier inscrit
jralonso