Extraire chemin et nom de classeur pour fonction

J

Julien

Guest
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:

Code:
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:

Code:
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:

Code:
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 :)
 
J

Julien

Guest
Re:Recherche

Merci Bebere pour toutes les explications sur le Quicksort, je vais essayer de le mettre en place.

Par contre, sur la feuil2 tu m'as fait une macro qui recherche BJI-201 puis elle met dans la variable Trouvé ce qu'il y a dans la cellule 'E' & L.
Mais moi ce que je voudrais c'est rechercher dans chaque cellule 'E' & L si elle contient (et non 'est égale à') 'PACK DE' ou 'PK' ou ... et ensuite arrive à extraire le nombre qui se trouve juste après ET qui se trouve donc toujours dans la même cellule (pour connaître le nombre de pack).
La colonne F sera égale au chiffre extrait (dans l'exemple du tableau de la feuil2 que tu as fait, la colonne F contiendrait 6,6,5,6,5). Et si il ne trouve aucun des mots clés ('PACK DE' ou 'PK' ou ...) la macro mettra 1 dans la colonne F.

L'avantage de cette colonne, c'est que je vais pouvoir diviser le prix du pack (qui se trouve dans la colonne B par exemple) par le chiffre qui se trouve dans la colonne F pour connaître le prix à l'unité.

A bientôt.
 
J

Julien

Guest
Re:Recherche

C'est bon j'ai réussi a le faire en utilisant les fonctions Instr et Left et Right plus qq conditions.

Sinon, je voulais savoir pourquoi mon processeur P4 n'est utilisé qu'à 50 % lorsque j'exécute ma macro. Est-ce qu'il y a une limitation par application de la quantité processeur utilisée?
Merci d'avance
A bientôt
 

Bebere

XLDnaute Barbatruc
Re:Recherche

bonjour Julien

essaye ce qui suit

Sub trouvechiffre()
Dim L As Integer, Tbl
L = Sheets('Feuil2').Range('D1').End(xlDown).Row
Tbl = Sheets('Feuil2').Range('E1:E' & L)
For L = 1 To (UBound(Tbl))
Range('F' & L).Value = NumberInText(Tbl(L, 1))
Next L
End Sub

Function NumberInText(C)
Dim I As Byte, L As Byte, Q As Byte
TheString = C
L = Len(TheString)
I = 1
While I <= L
C = Mid$(TheString, I, 1)
If IsNumeric(Mid$(TheString, I, 1)) Then Q = Mid$(TheString, I, 1)
I = I + 1
Wend
NumberInText = Q
End Function

à bientôt
 
J

Julien

Guest
Re:Recherche

Salut Bebere,

Dsl, je ne suis pas venu sur le forum depuis qq temps.
Merci de penser toujours à moi. :)
J'ai regardé ton code, mais en fait il faut pas qu'il y ait d'autres nombres dans la cellule. J'ai fait une fonction un peu plus bourin qui regarde les différents cas qui peuvent exister avec des If else If ...... End If End If...
Tu veras, c'est pas très court ;) Mais bon ca a l'air de marcher.

Je pourrais simplifier la syntaxe en fappelant une fonction parce que dans les if else il y a a peu prés toujours la même chose, à part le nombre de caractère que je peux mettre dans une variable et la chaine de caractère (carton de,...) qui change.


Sub pack()

Columns('C:C').Select
Selection.Insert Shift:=xlToRight
Selection.NumberFormat = 'General'
Range('C1').Select
ActiveCell.FormulaR1C1 = 'Qté par pack'

Dim Tbl() As String, DerK As Integer, K As Integer

DerK = Sheets('Prix augmenté').Range('A3').End(xlDown).Row

ReDim Tbl(1 To DerK, 1 To 2) 'dimensionne à x lignes,2 colonne

'Rempli
For K = 3 To DerK
Tbl(K, 1) = Sheets('Prix augmenté').Range('E' & K)
Next K
'Fin Rempli

'Remplace
For K = 1 To DerK

If InStr(Tbl(K, 1), 'PAGEPACK') <> 0 Then
Tbl(K, 1) = 1

Else:

If InStr(Tbl(K, 1), 'PAGE PACK') <> 0 Then
Tbl(K, 1) = 1

Else:

'1) CARTON DE:

'a) cartons de :
If InStr(Tbl(K, 1), 'CARTONS DE') <> 0 Then
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONS DE') - 9), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONS DE') - 10)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONS DE') - 9)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'b) carton__de
If InStr(Tbl(K, 1), 'CARTON DE') <> 0 Then
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTON DE') - 9), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTON DE') - 10)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTON DE') - 9)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'c) cartonde
If InStr(Tbl(K, 1), 'CARTONDE') <> 0 Then
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONDE') - 7), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONDE') - 8)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONDE') - 7)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'd) cartonsde
If InStr(Tbl(K, 1), 'CARTONSDE') <> 0 Then
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONSDE') - 8), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONSDE') - 9)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTONSDE') - 8)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:



'e) carton de
If InStr(Tbl(K, 1), 'CARTON DE') <> 0 Then
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTON DE') - 8), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTON DE') - 9)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'CARTON DE') - 8)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'2)PACK DE

'a)packs de
If InStr(Tbl(K, 1), 'PACKS DE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PACK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKS DE') - 7), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKS DE') - 8)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKS DE') - 7)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'b)pack__de
If InStr(Tbl(K, 1), 'PACK DE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PACK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK DE') - 7), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK DE') - 8)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK DE') - 7)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'c)packde
If InStr(Tbl(K, 1), 'PACKDE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PACK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKDE') - 5), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKDE') - 6)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKDE') - 5)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'd)packsde
If InStr(Tbl(K, 1), 'PACKSDE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PACKSDE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKSDE') - 6), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKSDE') - 7)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKSDE') - 6)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'e)pack de
If InStr(Tbl(K, 1), 'PACK DE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PACK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK DE') - 6), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK DE') - 7)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK DE') - 6)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'3)PK DE
'a) pks de
If InStr(Tbl(K, 1), 'PKS DE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKS DE') - 5), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKS DE') - 4)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKS DE') - 5)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'b)pk__de
If InStr(Tbl(K, 1), 'PK DE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK DE') - 5), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK DE') - 6)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK DE') - 5)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'c)pkde
If InStr(Tbl(K, 1), 'PKDE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKDE') - 3), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKDE') - 4)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKDE') - 3)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'd)pksde
If InStr(Tbl(K, 1), 'PKSDE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKSDE') - 4), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKSDE') - 5)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKSDE') - 4)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'e)pk de
If InStr(Tbl(K, 1), 'PK DE') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PK DE')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK DE') - 4), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK DE') - 5)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK DE') - 4)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'4)PACK
'a)packs
If InStr(Tbl(K, 1), 'PACKS') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PACK')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKS') - 5), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKS') - 4)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACKS') - 3)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'b) pack
If InStr(Tbl(K, 1), 'PACK') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PACK')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK') - 3), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK') - 4)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PACK') - 3)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'5)PK
'a)pks
If InStr(Tbl(K, 1), 'PKS') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PK')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKS') - 2), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKS') - 1)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PKS') - 2)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:

'b)pk
If InStr(Tbl(K, 1), 'PK') <> 0 Then
'Tbl(K, 2) = InStr(Tbl(K, 1), 'PK')
If Left(Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK') - 1), 1) = ' ' Then
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK') - 2)
Else:
Tbl(K, 1) = Right(Tbl(K, 1), Len(Tbl(K, 1)) - InStr(Tbl(K, 1), 'PK') - 1)
End If

If IsNumeric(Right(Left(Tbl(K, 1), 2), 1)) Then
Tbl(K, 1) = Left(Tbl(K, 1), 2)
Else:
Tbl(K, 1) = Left(Tbl(K, 1), 1)
End If

Tbl(K, 2) = IsNumeric(Tbl(K, 1))

Else:
If InStr(Tbl(K, 1), 'CARTON DE') = 0 And InStr(Tbl(K, 1), 'PACK DE') = 0 _
And InStr(Tbl(K, 1), 'PK DE') = 0 And InStr(Tbl(K, 1), 'PACK') = 0 And _
InStr(Tbl(K, 1), 'PK') = 0 Then
Tbl(K, 1) = 1
'Tbl(K, 2) = 'Rien trouvé'
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

Next K
'Fin Remplace

'Affiche
For K = 3 To UBound(Tbl)
Sheets('Prix augmenté').Range('C' & K).Value = Tbl(K, 1)
Next K
'Fin Affiche

''Affiche
'For K = 3 To UBound(Tbl)
'Sheets('Prix augmenté').Range('B' & K).Value = Tbl(K, 2)
'Next K
''Fin Affiche

End Sub
 
J

Julien

Guest
Re:Recherche

Salut Bebere, le forum

Il y a quelque chose que je n'arrive toujours pas à comprendre dans :

Code:
         For L = 1 To UBound(TblCompare, 1) 'Toutes les lignes de TblCompare
            Test = False
            For s = 1 To Worksheets.Count 'De s=1 jusqu'au nombre de feuille total de classeur
                If Test = True Then Exit For
                If Sheets(s).Name = TblCompare(L, 8) Then 'Si la feuille numéro s = Etat de la réf
                    Test = True
                    If Sheets(s).Cells(1, 1) = '' Then
                    L1 = 1 'Feuille pas encore remplie: L1=1
                    Else: L1 = Sheets(s).Columns(1).Find('*', , , , , xlPrevious).Row + 1
                    End If
                    'Remplissage de la feuille s avec toutes les colonnes de TblCompare
                    For C = 1 To UBound(TblCompare, 2)
                        Sheets(s).Cells(L1, C).Value = TblCompare(L, C)
                    Next C
                End If
            Next s
       Next L

Je ne comprends pas comment marche :
L1 = Sheets(s).Columns(1).Find('*', , , , , xlPrevious).Row + 1
Merci d'avance pour votre aide.
 
B

bebere

Guest
Re:Recherche

bonjour Julien
' dernière cellule non vide,ajout de 1 pour la 1ère cellule vide pour ton entrée
'les 3 lignes de code suivantes donne le même résultat
L1 = Sheets(s).Range('A1').End(xldown).Row + 1'pas de cellules vides ds les données
L1 = Sheets(s).Range('A65536').End(Xlup).Row + 1
L1 = Sheets(s).Columns(1).Find( * , , , , , xlPrevious).Row + 1
avec mon code ,pour extraire le chiffre fait une boucle qui commence
par la fin de la chaîne,cela te fera un exercice
à bientôt :)
 
J

Julien

Guest
Re:Recherche

Bonjour Bebere, merci pour les explications de la dernière fois.

Je voulais savoir si tu pouvais m'aider pour faire un formulaire.

Pour l'instant le code est :

'Ferme le formulaire quand l'utilisateur click sur OK
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub

'Affiche le texte rentré par l'utilisateur en 'E' & H
Private Sub TextBox1_AfterUpdate()
Dim H As Integer
H = Range('feuil1!A2').End(xlDown).Row
Range('feuil1!E' & H).Value = TextBox1.Value

End Sub

En fait je voudrais mettre 2 arguments en entrée M et H,
Pour que :
1) le formulaire m'affiche: 'Bonjour, cela fait' & M & 'jours que vous n'êtes pas venu', dans un objet texte. Mais c'est peut être pas très facile puisqu'on change le texte affichait dans Caption et je ne sais pas si on peut mettre des variables dedant.

2) J'aimerais aussi mettre H en entrée pour ne pas être obligé de le recalculer.

3) Et enfin je voulais savoir comment mettre un paramettre en sortie. Dans mon cas ce serait la variable Texte:

Private Sub TextBox1_AfterUpdate()
Texte = TextBox1.Value
End Sub

Merci d'avance :)
 

Bebere

XLDnaute Barbatruc
Re:Recherche

salut julien
UsfPourJulien
à bientôt
;) [file name=UsfPourJulien.zip size=9444]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/UsfPourJulien.zip[/file]
 

Pièces jointes

  • UsfPourJulien.zip
    9.2 KB · Affichages: 31

Discussions similaires

Statistiques des forums

Discussions
312 215
Messages
2 086 320
Membres
103 178
dernier inscrit
BERSEB50