Transformer ma fonction Recherche en code

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Transformer ma fonction Recherche en code

hoob91

Bonjour,
je souhaiterai intégrer ma fonction "Recherche " ci-dessous dans une macro :

=RECHERCHEV(C3;Tables!$A$3:$B$26;2;FAUX)

Merci de votre aide

Publicité

kiki29

Salut,un tuto sur RECHERCHEV http://fauconnier.developpez.com/t [...] rchev/#LVI

Message édité par kiki29 le 15-04-2011 à 10:12:01

hoob91

Effectivement complet, mais je démarre dans les macros alors entre worksheetFunction et Evaluate, quelqu'un pour m'aider à démarrer cette macro
Merci de votre aide

kiki29

Re,qqch comme ceci

Option Explicit

Sub Tst()
Dim s As String
s = Application.WorksheetFunction.VLookup(Sheets("Feuil1" ).Range("C3" ), Sheets("Tables" ).Range("A3:B26" ), 2, False)
MsgBox s
End Sub

ou encore

Function Rch(sRch As Variant) As String
Dim s As String
s = Application.WorksheetFunction.VLookup(sRch, Sheets("Tables" ).Range("A3:B26" ), 2, False)
Rch = s
End Function

Message édité par kiki29 le 15-04-2011 à 11:58:33

hoob91

Merci, je regarde cela de près

hoob91

La macro ci-joint retourne par le msgbox la valeur :
Sub Tst()
Dim s As String
s = Application.WorksheetFunction.VLookup(Sheets("Importation_Données" ).Range("B3" ), Sheets("Tables" ).Range("A3:B26" ), 2, False)
MsgBox s
End Sub

j'imagine qu'il me faut maintenant une boucle pour passer en revue l'ensemble des données, mais de quelle type ?
Merci

kiki29

Re,un filtre automatique semble plus approprié si tu veux avoir toutes les valeurs

Message édité par kiki29 le 15-04-2011 à 13:20:51

hoob91

L'objectif est de récuperer la donnée par la fonction WorksheetFunction.VLookup et de la copier dans la colonne (A:A)
je pense qu'il faut une boucle While, mais je ne maitrise pas encore le VBA

kiki29

Re,brut de fonderie

Sub Tst2()
Dim LastRow As Long, i As Long, j As Long, sRch As String
LastRow = Sheets("Tables" ).Range("A" & Rows.Count).End(xlUp).Row
sRch = Sheets("Feuil1" ).Range("C3" )
Application.ScreenUpdating = False
Sheets("Feuil1" ).Columns("A:A" ).ClearContents
For i = 1 To LastRow
If Sheets("Tables" ).Range("A" & i) = sRch Then
j = j + 1
Sheets("Feuil1" ).Range("A" & j) = Sheets("Tables" ).Range("B" & i)
End If
Next i
Application.ScreenUpdating = True
End Sub

Sub Tst3()
Dim LastRow As Long, i As Long, j As Long, sRch As Variant, Ar() As Variant
LastRow = Sheets("Tables" ).Range("A" & Rows.Count).End(xlUp).Row
sRch = Sheets("Feuil1" ).Range("C3" )
Application.ScreenUpdating = False
Sheets("Feuil1" ).Columns("A:A" ).ClearContents
For i = 1 To LastRow
If Sheets("Tables" ).Range("A" & i) = sRch Then
ReDim Preserve Ar(j)
Ar(j) = Sheets("Tables" ).Range("B" & i)
j = j + 1
End If
Next i
On Error Resume Next
Feuil1.Range("A1" ).Resize(UBound(Ar, 1) + 1) = Application.Transpose(Ar)
Application.ScreenUpdating = True
End Sub

et en ajoutant ceci dans Feuil1 pour déclencher Tst3 si changement dans C3

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Inter As Range
Set Inter = Application.Intersect(Target, Feuil1.Range("C3" ))
If Inter Is Nothing Then Exit Sub
Tst3
End Sub

Message édité par kiki29 le 15-04-2011 à 14:55:50

hoob91

Merci

Publicité

kiki29

PS : dépend de la casse ( ABc <>ABC <>abc )

hoob91

Bonjour à tous,
le problème du test de cette macro est que mm si la cellule Bi est vide, j'ai un message d'erreur.
Le test à blanc d'une cellule ne fonctionne pas ?

Sub Tst()
Dim s As String
Dim i As Integer

i = 3

Range("A3" ).Select

While Not (IsEmpty("B" & i))
'MsgBox "" + "B" & i
s = Application.WorksheetFunction.VLookup(Sheets("Importation_Données" ).Range("B" & i), Sheets("Tables" ).Range("A3:B27" ), 2, False)

Selection.Value = s
i = i + 1
Range("A" & i).Select
Wend

MsgBox ("Traitement terminé" )
End Sub

Merci de votre aide

kiki29

Salut,ceci fonctionne parfaitment,à toi de l'adapter à ton contexte
Balise ton code : Clic icône Editer le message puis sélection du code et clic sur icône Fixe

Message édité par kiki29 le 26-04-2011 à 09:06:17

hoob91

Merci, cela fonctionne parfaitement: voila ma solution :
Sub ClassDir()
Dim s As String, i As Integer, p As Integer, LastRow As Long

LastRow = Sheets("Importation_Données" ).Range("B" & Rows.Count).End(xlUp).Row

i = 3
p = 3

Range("A3" ).Select

For p = 3 To LastRow
If (("B" & i) <> "" ) Then
'MsgBox "" + "B" & i
s = Application.WorksheetFunction.VLookup(Sheets("Importation_Données" ).Range("B" & i), Sheets("Tables" ).Range("A3:B27" ), 2, False)
Selection.Value = s
i = i + 1
Range("A" & i).Select

End If
Next p
MsgBox ("Traitement terminé" )
End Sub

kiki29

Salut,cela m'étonnerait que ton code fonctionne,enfin bref , balise ton code : Clic icône Editer le message puis sélection du code et clic sur icône Fixe

Message édité par kiki29 le 26-04-2011 à 17:00:02

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Transformer ma fonction Recherche en code

Sujets relatifs
[Matlab] fonction porte	fonction compter mot identique entre deux chaines
[PHP] Recherche script d'enchères	Avoir la fonction "Sum" par défaut dans la table pivot
recherche fichiers xlsx et convertier en format xls	php recherche multi critère
Recherche d'une valeur	Decouper un code recursif
Macro excel en fonction d'un choix dans le classeur	[VBS] Recherche dossiers
Plus de sujets relatifs à : Transformer ma fonction Recherche en code

Page générée en 0.047 secondes