XL 2016 [Résolu]Application match VBA

[Etn]

Bonjour,

Je souhaiterais, en fonction du nombre en colonne A, placer une lettre en colonne B. Je pense qu'il faut utiliser le application.match mais je trouve pas la bonne méthode.

C'est bien plus clair avec l'exemple ci-joint.

Pourriez vous m'aider svp ?

Merci d'avance,
Etn

 

[sylvanu]

Bonjour ETN,
On peut le faire aussi avec une fonction perso :

Function ETN(N, P)
    L = Application.ThisCell.Row
    C = Application.ThisCell.Column
    If Cells(L, C - 1) = N Then
        ETN = P
    Else
        ETN = ""
    End If
End Function

Ce qui évite un bouton.

 

[sylvanu]

ou en automatique sans fonction avec un Worksheet_Change :

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Address = "$E$12" Or Target.Address = "$E$13" Then
        Range("B2:B100").ClearContents
        Ind = Application.Match(Range("E12"), Range("A:a"), 0)
        Cells(Ind, 2) = Range("E13")
    End If
End Sub

 

[job75]

Bonjour Etn, sylvanu,

Formule en B2 à tirer vers le bas =REPT(E$13;A2=E$12)

La fonction REPT prend bien moins d'octets en mémoire que la fonction SI.

A+

 

[job75]

Le VBA est inutile mais si l'on y tient on peut lui faire entrer la formule précédente en colonne B.

Voyez le fichier joint et cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("A1", UsedRange).Offset(1).Columns(2)
    .Formula = "=REPT(E$13,A2=E$12)" 'à adapter
    .Value = .Value 'supprime les formules
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Testée sur 100 000 lignes : la macro s'exécute chez moi en 0,45 seconde.

 

[job75]

Bien entendu il est plus logique d'utiliser Application.Match :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next
With Range("A1", UsedRange).Offset(1)
    .Columns(2).ClearContents 'RAZ
    .Cells(Application.Match([E12], .Columns(1), 0), 2) = [E13] 'à adapter au besoin
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Même sur 100 000 lignes l'exécution est immédiate.

Bonne nuit.

 

[Etn]

Bonsoir à tous,

Merci beaucoup pour votre aide !
J'ai pu me servir d'un de vos codes pour atteindre le résultat souhaité !

Je vous souhaite une bonne soirée !
Etn