Extraire chemin et nom de classeur pour fonction

  • Initiateur de la discussion Initiateur de la discussion Julien
  • Date de début Date de début
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 :)
 
Trier par date Trier par votes
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.
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
B

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
 
Vote positif 0 Vote négatif
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
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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 :)
 
Vote positif 0 Vote négatif
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
Cliquez pour agrandir...

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 :)
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question Question
XL 2021 Power Query : extraire tableaux et données de PDF
Réponses
0
Affichages
115
Florent74
F
G
  • Question Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
18
Affichages
1 K
GClaire
G
R
  • Question Question
Microsoft 365 Formule INDIRECT avec nom du classeur variable
Réponses
4
Affichages
714
job75
job75
Y
  • Question Question
Microsoft 365 chemin fichier dans une formule recherchev
Réponses
1
Affichages
727
sylvanu
sylvanu
P
  • Question Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
508
job75
job75
Z
  • Résolu(e)
XL 2021 Tester l'existence d'un nom d'onglet
Réponses
3
Affichages
272
jm.andryszak
J
jeff1494
  • Question Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
322
jeff1494
jeff1494
J
  • Question Question
XL 2010 définir un nom de cellule en fonction de la valeur d'une autre
Réponses
12
Affichages
848
jojo4738
J
I
  • Résolu(e)
Microsoft 365 SOMME.SI.ENS avec un critère de plusieurs mois
Réponses
7
Affichages
222
Tartine
T
O
  • Question Question
Microsoft 365 Problème complexe de recherche de valeurs
Réponses
6
Affichages
330
Olivier Corbin
O
T
  • Résolu(e)
XL 2010 VAB - Lister et renommer fichiers en bloc
Réponses
6
Affichages
380
tchi456
T
T
  • Question Question
Microsoft 365 Cacher / détailler certaines colonnes dans certains onglets avec mot de passe
Réponses
6
Affichages
647
ThierryP
T
A
  • Résolu(e)
Microsoft 365 Enregistrer copie d'un fichier avec pour nom le contenu d'une cellule excel (macro)
2
Réponses
15
Affichages
839
firecarl
F
P
  • Question Question
XL 2016 Automatiser une formule RECHERCHEV avec un nom de fichier différent en fonction du résultat d'une cellule
Réponses
10
Affichages
725
Phil69970
Phil69970
C
  • Résolu(e)
XL 2021 Duplication d'onglets dans un nouveau fichier et enregistrement selon une cellule donnée
Réponses
7
Affichages
434
wDog66
wDog66
M
  • Question Question
Microsoft 365 Formule nom et prénom
Réponses
4
Affichages
449
moanin
M
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
189
sylvanu
sylvanu
Jouxte
  • Question Question
XL 2021 coller une image interne au classeur
2 3
Réponses
33
Affichages
1 K
Jouxte
Jouxte
P
  • Résolu(e)
Microsoft 365 creer un dossier et sauvergarder un fichier PDF avec le meme nom
Réponses
5
Affichages
618
Lolote83
L
S
  • Question Question
Autres Blocages formules entre 365 et version Excel antérieur
Réponses
5
Affichages
397
JHA
J

Membres actuellement en ligne

14 membres et 416 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 293
Messages
2 118 125
Membres
113 434
dernier inscrit
thais1808