Aide sur un Code VBA : Fonction pérsonalisé (déclaration)

Bonjour tous le monde,

j'ai besoin d'aide sur un code VBA sous excel 2007, je suis débutant.

j'ai une fonction personnalisé je l'applique et sa marche normal sur le fichier mais le problème c'est lorsque les données sont bcp le fichier deviens plus lent , ce que j'ai essaye a faire c'est d’exécuté cette fonction pour la colonne spécifier une seule fois a l'aide d'un buttons.

ci-dessous le code :

Option Explicit

Function Lookup_tr(Search_string As String, _
  Search_in_col As Range, Return_val_col As Range)

Dim i As Long
Dim searching_val As Long
Dim result As String

For i = 1 To Search_in_col.Count
  If Search_in_col.Cells(i, 1) = Search_string Then
            result = result & "|" & Return_val_col.Cells(i, 1).Value
  End If
Next
Lookup_tr = Trim(result)
End Function

Sub JIG_Status_Auto_Check()
'declaration des variable

Dim StatusCell As Range 'cellule où les statuts des JIG exister
Dim SynchroTr As Range 'Cellule du Tr de base pour synchronisation
Dim sourceRange As Range
Dim destrange As Range
Dim BaseWks As Worksheet
Dim InfoWks As Worksheet
Dim R_Final As String

BaseWks = Worksheets("Sheet1") 'Feuille du base dont il existe le "Key de base" rechercher
InfoWks = Worksheets("Sheet2") ''Feuille des infor dont il existe les infos de la Base de données "Matrice données"
sourceRange = BaseWks.Cells(i, 1).Value
destrange = InfoWks.Range("A2:L100")
StatusCell = InfoWks.Cells(i, 1).Value
SynchroTr = InfoWks.Cells(i, 1)

R_Final = Lookup_tr(sourceRange, destrange, StatusCell)

End Sub

et aussi le fichier ci joint

merci d'avance

Bonsoir,

ce que j'ai essaye a faire c'est d’exécuté cette fonction pour la colonne spécifier une seule fois a l'aide d'un buttons.

Et bien ce n'est plus une fonction qu'il faut faire, mais un sub qui balaie ta plage.

eric

oui eric, merci pour ta réponse

j'ai declaré la fonction, puis j'ai appelé aprés cette fonction dans le SUB . c'est exactement ou je me trompe , car dans le sur ca serra aussi avec des variable !!

merci

Haytoch

Bonjour,

essaie en français stp.

Et si tu pouvais décrire ce qu'est sensées faire ta fonction.

eric

Bonsoir Eric,

Dsl, je suis pas fort en français , mais je vais essayer de mieux expliquer :

1-Définition de la fonction:

c'est une fonction définis comme "RECHERCHEV" , mais cella permet d'obtenir la valeurs d'un tell cellule chaque fois il trouve la Valeur Rechercher dans le Tableaux spécifier !

RechercheV==> retourner plusieurs valeurs à une cellule .

NB: La Fonction Marche bien (Voir le modul du code VBA et la colonne "M" dans la feuille 1 "Sheet1").

2-L'objectif:

Je veux que cette fonction soit exécutable par un bouton pour tous les cellules de la colonne "M", lors du besoin, car le fichier deviens très lourd, avec la méthode standard .

Et aussi de me faire retourner la valeur qui est dans "Sheeet2" de la Cellule-Colonne "D" si la valeur dans la Cellule-Colonne "K" ="TR CUT" ou "TR DEL" , si non passe.

Merci

Bonjour,

ta fonction marche peut-être très bien mais il va falloir l'abandonner.

Si tu veux traiter le tableau en une fois, qu'il fait 1000 lignes avec 2000 lignes de keys différentes tu vas faire 2000000 boucles car à chaque ligne tu vas re-balayer toutes les keys...

Tu n'auras plus de gèle lors de la saisie mais lors de la mise à jour tu attendras de longues secondes (minutes ?)

Il faut lire une fois toutes les keys pour fabriquer tous les statuts concaténés et ensuite les mettre sur chaque ligne du tableau.

Je te l'ai fait avec l'objet Dictionary qui est très rapide.

Sub concatStatut()
    Dim sh As Worksheet, shAct As Worksheet
    Dim Dict, key As Variant, pl() As Variant, lig As Long
    Dim t As Single
    '
    t = Timer
    Set shAct = ActiveSheet
    Set sh = Worksheets("Sheet2")
    Application.ScreenUpdating = False
    'concaténation statuts
    Set Dict = CreateObject("Scripting.Dictionary")
    sh.Activate
    pl = sh.Range("a2", [a65000].End(xlUp)).Value
    shAct.Activate
    lig = 2
    For Each key In pl
        Dict(key) = Dict(key) & "|" & sh.Cells(lig, 11)
        lig = lig + 1
    Next key
    ' appliquer
    Set sh = Worksheets("Sheet1")
    For lig = 2 To sh.Cells(Rows.Count, 1).End(xlUp).Row
        Cells(lig, 13) = Dict.Item(Cells(lig, 1).Value)
    Next lig
    Application.ScreenUpdating = True
   MsgBox Timer - t & "  s"
End Sub

Et aussi de me faire retourner la valeur qui est dans "Sheeet2" de la Cellule-Colonne "D" si la valeur dans la Cellule-Colonne "K" ="TR CUT" ou "TR DEL" , si non passe.

Pas trop compris où tu le veux ni à quelles conditions mais je pense que tu n'auras pas de mal à l'ajouter...

eric

Merci Eric , comme ça plus simple et rapide

+1

Sa marche bien après la modification

Merci