XL 2010 Recherche d'une sous chaine de caractere dans un "array"

didier_r

XLDnaute Nouveau
Bonjour,

J'ai un morceau de code qui fonctionne bien mais qui est bien trop long a s'exécuter.
Il s'agit en fait de deux feuilles de calcul, une qui contient des variables (et oui, l'automatisme se met à Excel !) et l'autre contient du programme.
Par exemple, contenu de la premiere feuille :

B0CLIGNOTCLIGNOTANT
B4BININITBIT DE FIN D'INITIALISATION
B6VFICC10VFI ET VALIDATION COMPT. 1/10s TR DE PRG
B7VFICCTRVFI COMPTEUR TOUR DE PROGRAMME
B8BTSCC10VAT COMPTEUR 1/10
B9BTSCCTRVAT COMPTEUR TOUR DE PROGRAMME

Par exemple, contenu de la seconde feuille :

L56.M511,M70<-2390.
L57.M70<-M70+1.MISE A JOUR TABLE DES MESSAGES
L58.M511,M70<-2400.EDITION HEURE DE REDEMARAGE AUTOMATE
L59.B4<-1.ACTIVATION BIT EN FIN D'INITIALISATION
L60.->1023.

Mon petit bout de code prend chaque variable de la premiere feuille (B0 par exemple) et balaye la seconde feuille.
Si la variable est trouvee, je copie l'adresse où la variable est utilisée (L59 pour B4).

Mon code (voir ci-dessous un extrait) fonctionne directement sur les feuilles, ce qui est (très, voire trop) long.

var = tab_var(ind_var, 1) & "<-"

With Range(Cells(1, 1), Cells(max_calc, 1))
Set LastCell = .Cells(.Cells.Count)
End With

Set FoundCell = Range(Cells(1, 1), Cells(max_calc, 1)).Find(what:=var, LookIn:=xlValues, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
FirstAddr = FoundCell.Address
End If

Do Until FoundCell Is Nothing
line = Left(FoundCell.Value, InStr(FoundCell.Value, ".") - 1)
If Left(line, 1) = "L" Then
Feuil3.Activate
If Feuil3.Cells(ind_var, 6) = "" Then
Feuil3.Cells(ind_var, 6) = line
Else
Feuil3.Cells(ind_var, 6) = Feuil3.Cells(ind_var, 6) & ", " & line
End If
Feuil2.Activate
End If

Set FoundCell = Range(Cells(1, 1), Cells(max_calc, 1)).FindNext(after:=FoundCell)

If FoundCell.Address = FirstAddr Then
Exit Do
End If


Pour gagner du temps, je souhaite le transformer pour travailler avec des "array".
Je sais transferer le contenu des feuilles dans les tableaux, et rapatrier le contenu du tableau dans les feuilles.
Par contre, je bute sur les fonctions de recherche.

Si vous avez une idée, un (non, des) conseil, je suis preneur !

Bonne journée,

Didier

 

Roblochon

XLDnaute Accro
Re bonjour,

Un fichier exemple sans données confidentielles serait plus parlant.
Dans votre exemple vous parlez de variable (BO) qui apparemment n'est pas une variable mais une constante. Qui, d'ailleurs n'apparaît pas dans l'exemple de feuil2.
Dites également s'il s'agit d'une référence "BO" à trouver et si elle peut apparaître plusieurs fois dans la feuille 2, si elle est toujours dans la même colonne.

Cordialement
 

didier_r

XLDnaute Nouveau
Re bonjour !

Autant pour moi, avec le regard "excel", B0 est bien une constante.
Dans mon exemple, la constante B4 est bien dans les deux feuilles.
Une même constante peut apparaitre plusieurs fois dans la feuille 2, feuille qui ne contient qu'une seule colonne.
Je joins un fichier exemple ...

Cdt
 

Fichiers joints

Roblochon

XLDnaute Accro
Bonjour,

Dans le fichier joint, un module avec deux macros:
1 - (Sub Rechercher) qui mets 21 secondes à effectuer les recherches. Elle utilise une comparaison par Like et 3 boucles (21 secondes) dans trois tableaux,
2 - (Sub Rechercher_2) qui met la moitié moins de temps et utilise les expressions régulières et deux boucles (9.47 secondes)

Temps valables sur ma machine évidement.
il y a 9430 variables * 9 combinaisons à chercher dans 592 lignes

Les résultats sont affichés en colonne E de la feuille Variables. Les 439 première variables, n'ayant pas de correspondances, il faut descendre pour voir les résultats.
Les commentaires de votre macros ne m'ont pas permis de comprendre sans ambiguïté comment vous vouliez faire vos recherches. Aussi je me suis concentré sur la forme plutôt que le fond. A vous de voir, vérifier et adapter.

en attendant mieux, bonne continuation
 

Fichiers joints

didier_r

XLDnaute Nouveau
MErci ! ca marche nickel
J ai parcouru le code pour comprendre votre demache.
J ai compris à un ou deux détails prets :
- pourquoi faire dans un cas "datas = Application.Transpose(.............) " et dans l'autre cas "Vars = .Range(..............)" puisque DATAS et Vars sont tous les deux des tableaux ?
- Comment fonctionne "...rgx.Pattern = Vars(i, 1) & "((<-)|\+|-|\*|\/|,|=|\.|(->))"..." ?

Je vais creuser un peu sur le forum :)

Encore merci !
Pour moi le sujet est clos !
 

Roblochon

XLDnaute Accro
Re,

Pour vous montrer deux façons de faire.
Sur une plage de cellules en une colonne, Application.Transpose(.....) permet de retourner un tableau à 1 dimension
Vars= .Range("......") renvoie un tableau à deux dimensions (ligne,colonne)
Aidez-vous des outils de debogage de l'éditeur de macro.
Mettez des point d'arrêt (f9) sur les lignes que vous voulez, lancez la macro et menu Affichage/Fenêtre variable locales
vous aurez accès aux variables et leur état à ce moment là.

Edit: pour rgx.Pattern il faut faire des recherches(ce forum, google etc) sur les expressions régulières.

Bonne soirée
 
Dernière édition:

zebanx

XLDnaute Accro
Bonsoir Didier_r, Roblochon

@Roblochon
Vraiment bravo vraiment pour cette double proposition.
J'ai essayé d'utiliser un sub faisant appel à "regex" (et j'ai galéré :p) mais c'est nettement plus long à traiter, pour ne pas dire impossible sur une telle plage.
Merci à toi et bonne soirée.
 
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Bonjour,

Un essai de recherche un mot dans un Array() avec Filter()

VB:
Sub essaiFilter1()
  Set f = Sheets("calcul")
  f.[D2:D1000].ClearContents
  Motcherché = "BLOC"
  Set Rng = f.Range("A1:A" & [A65000].End(xlUp).Row)
  TblBD = Application.Transpose(Rng.Value)
  TblRes = Filter(TblBD, Motcherché, True, vbTextCompare)
  If UBound(TblRes) > 0 Then f.[D2].Resize(UBound(TblRes)) = Application.Transpose(TblRes)
End Sub
Pour rechercher plusieurs mots:

VB:
Sub essaiFilter1()
  Set f = Sheets("calcul")
  f.[D2:D1000].ClearContents
  motcherché = "CPLR BLOC"
  Set Rng = f.Range("A1:A" & [A65000].End(xlUp).Row)
  TblBD = Application.Transpose(Rng.Value)
  mots = Split(motcherché, " ")
  TblRes = TblBD
  For m = LBound(mots) To UBound(mots)
    TblRes = Filter(TblRes, mots(m), True, vbTextCompare)
  Next m
  If UBound(TblRes) > 0 Then f.[D2].Resize(UBound(TblRes)) = Application.Transpose(TblRes)
End Sub
Boisgontier
 

Fichiers joints

Dernière édition:

Discussions similaires


Haut Bas