Transformer ma fonction Recherche en code

Transformer ma fonction Recherche en code - VB/VBA/VBS - Programmation

Marsh Posté le 15-04-2011 à 09:49:38    

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

Reply

Marsh Posté le 15-04-2011 à 09:49:38   

Reply

Marsh Posté le 15-04-2011 à 10:10:18    

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


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

Marsh Posté le 15-04-2011 à 10:41:18    

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

Reply

Marsh Posté le 15-04-2011 à 11:44:25    

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
Reply

Marsh Posté le 15-04-2011 à 12:39:41    

Merci, je regarde cela de près

Reply

Marsh Posté le 15-04-2011 à 13:01:01    

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

Reply

Marsh Posté le 15-04-2011 à 13:19:04    

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
Reply

Marsh Posté le 15-04-2011 à 13:29:26    

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

Reply

Marsh Posté le 15-04-2011 à 13:38:56    

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


 
ou


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
Reply

Marsh Posté le 15-04-2011 à 14:56:27    

Merci

Reply

Marsh Posté le 15-04-2011 à 14:56:27   

Reply

Marsh Posté le 15-04-2011 à 15:35:47    

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

Reply

Marsh Posté le 26-04-2011 à 08:47:01    

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

Reply

Marsh Posté le 26-04-2011 à 08:59:08    

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


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


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

Marsh Posté le 26-04-2011 à 14:25:19    

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

Reply

Marsh Posté le 26-04-2011 à 16:55:10    

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
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed