Extraire chemin et nom de classeur pour fonction

[Julien]

Bonjour,

Je voudrais faire une fonction qui compare les cellules A2,A3... de la feuille ouverte à une autre feuille.

Pour cela j'utilise la fonction RECHERCHEV:

RECHERCHEV(A2;'D:\\Mes documents\\Excel\\[SuperClasseur.xls]SuperClasseur'!$1:$65536;5;0)

Ca marche pour ce classeur spécifique mais il faudrait que ca marche pour n'importe quel classeur.
Pour cela, il faut que j'utilise par exemple les variables 'CheminFichier' et 'NomClasseur'dans ma formule qui serait donc de cette forme:

RECHERCHEV(A2;'CheminFichier[NomClasseur.xls]NomClasseur'!$1:$65536;5;0)

Il y a bien une fonction pour demander à l'utilisateur le chemin d'un fichier à partir d'un explorateur, mais celle-ci retourne le chemin complet du fichier:

FichierChoisi = Application.GetOpenFilename('fichier excel, *.xls', , 'Donner le chemin du fichier à comparer')

J'ai donc par exemple FichierChoisi= 'D:\\Mes documents\\Excel\\SuperClasseur.xls
Je voulais savoir comment extraire le nom du classeur (sans xls) et le chemin (sans le nom du fichier) pour ensuite les placer dans ma formule.

Ou peut-être existe t-il une façon différente pour résoudre mon problème...?

Et si en même temps vous connaissait le code de la boucle pour que ma macro affiche sur la cellule suivante le résultat de la formule en A3... et qu'elle s'arrête lorsque la cellule A.. est vide.

Je vous en remercie d'avance

 

[Julien]

Re:JulienDer

Bonjour Bebere,

J'ai résolu mon problème (qui était que la macro ne traitait pas la 1ère ligne): j'ai rajouté une ligne au début! en mettant une barre de titre.
Si au cas où tu as le temps, j'aimerais quand même bien savoir ce qu'il fallait modifier.

Sinon, j'ai envi de m'acheter un livre pour apprendre à faire des macros, et qui soit bien expliqué, avec des exemples et toutes les notions importantes. Tu n'aurais pas un livre à me conseiller ?

 

[Bebere]

Re:JulienDer

bonjour Julien
fait des changements(surtout à la fin)
ajouté commentaires
le meilleur des livres que j'ai trouvé,c'est içi
et on peut continuer ensemble
à bientôt [file name=JulienV3.zip size=43474]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/JulienV3.zip[/file]

 

[Julien]

Re:JulienDer

Bonjour,

Merci pour les modifs et de vouloir toujours m'aider
C'est très bien ce que tu as fait pour rajouter les onglets, c'était assez dur à comprendre mais j'ai quand même réussi à voir ce que faisaient les différentes parties; à part :

1) Dim NomSheet As New Collection
Set NomSheet = New Collection
Je pense que c'est la manière de déclarer une suite d'éléments. Par contre Collection n'est pas en bleu dans l'éditeur (contrairement à Integer par exemple), alors, je me demandais si c'était un type compartant une suite d'élément s'appelant Collection?

2)'sans doublons
For L = 1 To UBound(TblCompare, 1)
On Error Resume Next
NomSheet.Add CStr(TblCompare(L, 3)), CStr(TblCompare(L, 3))
On Error GoTo 0
Next L
Je comprends pas très bien comment fonctionne :
-Resume Next
-CStr
-GoTo 0?

Après le reste j'ai réussi à comprendre à peu près comment marchait le remplissage des feuilles, c'est quand même très bien fait!

Et sinon sur le double for pour mettre les * aux ref toujours existantes :

For L = 1 To UBound(Plg1)
    For L1 = 1 To UBound(Plg2)
        If Plg1(L, 1) = Plg2(L1, 1) And Plg1(L, 1) <> '' And Plg2(L1, 1) <> '' Then 'Si on trouve une réf de Plg1 dans Plg2
        L2 = L2 + 1 'alors on incrémente L2
        Plg1(L, 3) = '*': Plg2(L1, 3) = '*' 'On remplie la 3ème col de Plg1 avec une étoile ainsi que Plg2
        End If
    Next L1
Next L

Je voulais l'optimiser pour qu'elle ne fasse pas toutes les réf de Plg2 à chaque fois, mais qu'elle s'arrête dès qu'elle a trouvé la réf.
Pour cela, je voulais faire qch de ce genre

For L = 1 To UBound(Plg1)
Faire
        If Plg1(L, 1) = Plg2(L1, 1) Then
        Test_etoile = true
        Plg1(L, 3) = '*': Plg2(L1, 3) = '*' 
        End If
L1=L1+1
Tant que (Test_etoile = false Or Plg2(L1, 3)<> ''  )
Next L

J'aimerais bien que tu me dises comment on fait un Faire tant que.
Merci d'avance.
A bientôt

 

[Julien]

Recherche

Je voulais rajouter une petite question:
Pour remplacer le double For que je t'ai décrit dans mon dernier message, serait-il possible tout d'abord de laisser le 1er For et au lieu de faire un 'Faire... Tant que' à la place du 2ème For (comme je voulais le faire), j'aimerais bien utiliser une recherche dichotomique! J'ai fait ca l'année dernière et ce serait vraiment bien que je le mette dans mon programme B) . Pour l'instant, j'ai un peu tout oublié sur les notions de recherche, mais je vais essayer de me rappeler comment on fait.
Si tu t'y connais, j'aimerais bien avoir de tes conseils.
Merci d'avance

 

[ChTi160]

Re:Recherche

Salut Julien
Salut Bebere

je me permet cette intrusion pour te dire Julien que pour Quitter une boucle For il te suffit de mettre dans ta procèdure Exit For

dans ton exemple

For L = 1 To UBound(Plg1)
    For L1 = 1 To UBound(Plg2)
        If Plg1(L, 1) = Plg2(L1, 1) And Plg1(L, 1) <> '' And Plg2(L1, 1) <> '' Then 'Si on trouve une réf de Plg1 dans Plg2
        L2 = L2 + 1 'alors on incrémente L2
        Plg1(L, 3) = '*': Plg2(L1, 3) = '*' 'On remplie la 3ème col de Plg1 avec une étoile ainsi que Plg2
   EXIT FOR  'ici si on a trouvé on quitte la boucle
        End If
    Next L1
Next L

si j'ai bien Compris lol

 

[Julien]

Re:Recherche

Merci Jean Marie, c'était effectivement ca que je voulais savoir.

J'aurais bien aimé avoir vos avis pour faire une recherche dichotomique à la place, en regardant à chaque fois le milieu du tableau pour diviser le problème par 2. (Problème en Ln(N) au lieu de N).

deb = 1
fintab = UBound(Plg2)

''

For L1 = 1 To UBound(Plg2)

    i = (deb + fintab) / 2
    If Plg1(L, 1) < Plg2(i, 1) Then 'où L est une constante
        fintab = i + 1
    Else
        deb = i - 1
    End If

    If Plg1(L, 1) = Plg2(i, 1) Then
        L2 = L2 + 1 'alors on incrémente L2
        Plg1(L, 3) = '*': Plg2(i, 3) = '*'
        Exit For
    End If

    If deb > fintab Then
        Exit For
    End If

Next L1

Ca ne bug pas, mais avec ce code j'ai beaucoup plus de nouveaux produits et anciens produits.
Il y a aussi L2 qui doit être plus petit que la normale, puisque TblCompare est plus grand. Ref obso, dev obso, Prix augm et dim n'ont pas l'air de changer.
Sinon, j'ai bien fait un tri avant d'effectuer ma recherche.

 

[Julien]

Re:Recherche

J'ai oublié de vous mettre le For qui englobe le code que j'ai écrit juste au dessus et aussi L2:

L2 = 0
    
Dim deb As Integer
Dim fintab As Integer
Dim i As Integer 'Indice


 For L = 1 To UBound(Plg1)

CODE AU DESSUS

Next L

'L2 = nbre de réf présentes ds les 2 Plg + nbre de réf plus en vente + nbre de réf nouvelles
L2 = L2 + (UBound(Plg2) - L2) + (UBound(Plg1) - L2)
'On redimensionne TblCompare à la bonne taille
 ReDim TblCompare(1 To L2, 1 To 8)

 

[Julien]

Re:Recherche

Dsl de faire 3 msg pour la même chose, mais je voulais aussi dire que dans ma recherche dichotomique 2 message plus haut, j'ai marqué : For L1 = 1 To Ubound (Plg2), mais bien sûr il n'ira jamais jusque là, il y a 2 Exit For lorsque la recherche est terminée. Je voulais savoir s'il y avait un autre truc à mettre qch du style:
repeat ... until (ce que j'ai mis en Exit For)

 

[bebere]

Re:Recherche

re
L est une variable

un exemple avec imprimante
en même temps,réponse à tes questions
testé,très rapide

'exemple d'utilisation de la fonction QuickSort
'trie la plage A2:E9 sur la 1ème colonne (A)
'et renvoie le résultat trié en G1

Sub Tester1()
Set rng = Range('A2:E9')
vArr = rng.Value

QuickSort vArr, 1, LBound(vArr, 1), UBound(vArr, 1)
Range('G1').Resize(UBound(vArr, 1), UBound(vArr, 2)).Value = vArr
End Sub


Sub QuickSort(SortArray, col, L, R)
'
'Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a second dimension greater than 1 (or zero)
'Tom Ogilvy, mpep

Dim i, j, X, Y, mm

i = L
j = R
X = SortArray((L + R) / 2, col)

While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j > L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
If (L < j) Then Call QuickSort(SortArray, col, L, j)
If (i < R) Then Call QuickSort(SortArray, col, i, R)
End Sub

à bientôt

 

[Julien]

Re:Recherche

Bonjour Bebere,

J'ai un peu de mal à comprendre la fonction quicksort, je l'ai 'étudié' l'année dernière, mais je crois que c'est une fonction de tri et non de recherche. J'aimerais bien que tu m'éclaircisse un petit peu plus sur ce point et si possible que tu me mette des commentaires. Merci d'avance.
A bientôt.

 

[bebere]

Re:Recherche

bonjour Julien,le Forum
dès que possible
va consulter ce fil ou Thierry a fait une belle démonstration sur les tableaux avec explications,svp
DEMO UserForm tri multiple/suppression doublons ; Par : Akeya06
Ce lien n'existe plus
à bientôt

 

[Julien]

Re:Recherche

Merci Bebere,

J'ai réfléchi sur le fil que tu m'as donné tout le WE, mais je n'arrive pas à avancer.
J'ai donc choisi de faire d'autres modifications, j'aimerais savoir si c'est possible de faire :

For i = 1 jusqu'à fin
Si Ei contient 'PACK DE ' ou 'PK DE '
Alors : J= le chiffre qu'il y a après 'PACK DE ' ou 'PK DE '
Fin si

Je ne sais pas si c'est réalisable mais si c'est possible, je serais très content de savoir comment ca ce code.
Merci d'avance.

 

[bebere]

Re:Recherche

bonjour Julien

Sub Essai()

'For i = 1 jusqu'à fin
For i = 1 To 10
'Si Ei contient PACK DE ou PK DE
If e(i) = 'PACK DE' Or e(i) = 'PK DE' Then
'Alors : J= le chiffre qu'il y a après PACK DE ou PK DE
J = i + 1
'Fin si
End If
next i

End Sub

à bientôt

 

[Julien]

Re:Recherche

Merci Bebere, mais je pense que ca s'applique si le nombre est dans une autre cellule. Je vais essayer de mieux t'expliquer mon problème...
Dans mon cas tu as dans chaque cellule de la colonne E des informations du style:

CARTOUCHE JAUNE PAR PACK DE 6 POUR I9950
BJI-201 M : ENCRE MAGENTA VENDU PAR PK 6
BJI 201 ENCRE JAUNE VENDU PAR PK DE 5
BCI-3 E PM : (P/BJC-3000/ 6000/6100/6200/SILVER/6500) PACK 6
CARTOUCHE ENCRE CYAN VENDU PAR CARTON DE 5 CARTOUCHES

Déjà, ce n'est pas toujours la même chose (PACK DE X, PK X, PK DE X, PACK X, CARTON DE X CARTOUCHES)

Donc je pense qu'il faudrait mettre dans une variable string, la valeur de la cellule:
Dim valeur As String 'J'arrive quand même a déclarer la variable !

Et après je ne sais pas comment on peut effectuer une recherche dans cette chaine de caractère, peut être avec un indice pour savoir ou l'on se situe et récupérer la valeur d'après si c'est un chiffre.

Merci d'avance.

 

[bebere]

Re:Recherche

bonjour Julien
mis commentaires ds le code
à bientôt [file name=PourJulien.zip size=16118]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/PourJulien.zip[/file]