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

[didier_r]

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 :

B0	CLIGNOT		CLIGNOTANT
B4	BININIT		BIT DE FIN D'INITIALISATION
B6	VFICC10		VFI ET VALIDATION COMPT. 1/10s TR DE PRG
B7	VFICCTR		VFI COMPTEUR TOUR DE PROGRAMME
B8	BTSCC10		VAT COMPTEUR 1/10
B9	BTSCCTR		VAT 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

 

[Hasco]

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]

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

 

[Hasco]

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

 

[didier_r]

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 !

 

[Hasco]

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

 

[didier_r]

Bonne soiree a vous !

 

[zebanx]

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é 😛) mais c'est nettement plus long à traiter, pour ne pas dire impossible sur une telle plage.
Merci à toi et bonne soirée.

 

[BOISGONTIER]

Bonjour,

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

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:

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