XL 2010 Fonction Left in Vlookup

[victors21]

Bonjour le Forum,

Je suis débutant en VBA, et je bloque sur une formule avec un gauche sur une plage de cellules dans un recherchev. Je me doute qu'il me manque du conditionnement mais lequel ?

Dans l'onglet "Synthèse", je trouve en cellule A4 ma cellule référence et en cellule B4 le résultat que je souhaite manuellement intégrer
Dans l'onglet "Base", je trouve ma colonne C des références et en colonne G le résultat de la macro

Je souhaite que si A4="B", il me change toutes les références commençants par B sinon il garde la formule pour le reste
Je souhaite que si A4="B5", il me change uniquement la référence B5 sinon il garde la formule pour le reste

Ma formule actuelle est la suivante:

"Sub Recherchev()

If Len(Sheets("Synthèse").Range("A4") = 1) Then
Sheets("Base").Range("G3:G33").Formula = Application.IfError(WorksheetFunction.VLookup(Left(Sheets("Base").Range("C3:C33"), 1), Sheets("Synthèse").Range("A4:B4"), 2, False), Sheets("Base").Range("G3:G33").Formula)
Else
Sheets("Base").Range("G3:G33").Formula
End If

If Len(Sheets("Synthèse").Range("A4") = 2) Then
Sheets("Base").Range("G3:G33").Formula = Application.IfError(WorksheetFunction.VLookup(Left(Sheets("Base").Range("C3:C33"), 1), Sheets("Synthèse").Range("A4:B4"), 2, False), Sheets("Base").Range("G3:G33").Formula)
Else
Sheets("Base").Range("G3:G33").Formula
End If

End Sub"

D'avance merci.

 

[jpb388]

Bonjour à tous
essaye ceci
elle ne met pas de formule mais elle fait le travail demandé

Sub Ventilation()
    Dim Lg%, Plage As Range, Cel As Range, ShRef As Worksheet, Sh As Worksheet, Ref As Range
    Set Sh = Sheets("Base"): Set ShRef = Sheets("Synthèse"): Set Ref = ShRef.Range("A4")
    Lg = Sh.Range("C" & Rows.Count).End(xlUp).Row
    Set Plage = Sh.Range("C3:C" & Lg)
    Select Case Len(Ref)
        Case 0
            MsgBox "Impossible de lancer la macro", vbCritical + vbOKOnly, "Valeur erronée"
        Case 1
            For Each Cel In Plage
                If Left(Cel, 1) = Ref Then Cel.Offset(, 4) = ShRef.Range("B4")
            Next Cel
        Case Else
            For Each Cel In Plage
                If Cel = Ref Then Cel.Offset(, 4) = ShRef.Range("B4"): Exit For
            Next Cel
    End Select
End Sub

 

[victors21]

Bonjour Jpb388,

Effectivement, cela marche, c'est top !!!
Je l'ai testé sur 4 niveaux (2 dans l'exemple), et ça fonctionne très bien.

Merci beaucoup à toi pour ton aide !!!