XL 2010 Nmb de fois le nom d'un fichier dans un tableaux

Bens7

XLDnaute Impliqué
Bonjour a tous !!
Alors voila après avoir chercher plusieurs option (Google+Forum)
je me tourne vers vous :

- J'ai un dossier comportant des logs (enfait des fichier txt vide) (voir dossier : /RESEAUX/EN COURS)
exemple: Tomate1.txt ; Tomate6.txt; Tomate3.txt

- Et dans mon tableau je voudrais calculer le nombre de fois ou un produit existe en log.
exemple: "Tomate" = 3 (il y a 3 fichier comportant le mot "Tomate" dans le dossier)

Voila je vous est mis un petit dossier + un FAKE bouton pour éclaircir :

P.S: Mon fichier réel comporte en fait plus de 300 lignes repartie sur 9 catégorie...donc plus de 4000 mot a tester léger au max...si possible.

Merci d'avance novice VBA (adaptation minimum)
 

Fichiers joints

chezswan

XLDnaute Occasionnel
Bonjour a tous !!
Alors voila après avoir chercher plusieurs option (Google+Forum)
je me tourne vers vous :

- J'ai un dossier comportant des logs (enfait des fichier txt vide) (voir dossier : /RESEAUX/EN COURS)
exemple: Tomate1.txt ; Tomate6.txt; Tomate3.txt

- Et dans mon tableau je voudrais calculer le nombre de fois ou un produit existe en log.
exemple: "Tomate" = 3 (il y a 3 fichier comportant le mot "Tomate" dans le dossier)

Voila je vous est mis un petit dossier + un FAKE bouton pour éclaircir :

P.S: Mon fichier réel comporte en fait plus de 300 lignes repartie sur 9 catégorie...donc plus de 4000 mot a tester léger au max...si possible.

Merci d'avance novice VBA (adaptation minimum)
Bonjour,

Voir si la formule dans la cellule surlignée en jaune convient.

Swan
 

Fichiers joints

youky(BJ)

XLDnaute Barbatruc
Bonjour tous,
Voici une macro à mettre en Module
J'ai pris Feuil1 c'est le codename de l'onglet donc à modifier si besoin.
Bruno
VB:
Sub faitboulot()
rep = ThisWorkbook.Path & "\RESEAUX\EN COURS\"
fichier = Dir(rep)
Do While fichier <> ""
  tx = Left(fichier, Len(fichier) - 4)
For k = 1 To Len(tx)
If Not IsNumeric(Mid(tx, Len(tx) - k, 1)) Then
tx1 = Left(tx, Len(tx) - k): n = Replace(tx, tx1, "")
Exit For
End If
Next
  Set c = Feuil1.UsedRange.Find(tx1, LookIn:=xlValues)
  If Not c Is Nothing Then
  c.Offset(0, 1) = c.Offset(0, 1)+val(n)
  End If
  fichier = Dir
Loop
End Sub
 
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Bonjour Tous,
Il y a encore une solution, c'est pas d'additionner les chiffres en fin de noms de fichier mais simplement compter le nbre de fichier Carotte ou autres.
Dans ce cas voici la macro.
Attention si c'est la 1ère macro qui est utilisée il faut rectifier la ligne >>>Set c...... comme dans cette macro pour trouver la valeur exact
Exemple Courge et Courgette, il pouvait trouver Courge dans Courgette.
Bruno
VB:
Sub fake()
rep = ThisWorkbook.Path & "\RESEAUX\EN COURS\"
fichier = Dir(rep)
Do While fichier <> ""
  tx = Left(fichier, Len(fichier) - 4)
For k = 1 To Len(tx)
If Not IsNumeric(Mid(tx, Len(tx) - k, 1)) Then
tx = Left(tx, Len(tx) - k)
Exit For
End If
Next
  Set c = Feuil1.UsedRange.Find(tx, lookat:=xlWhole)
  If Not c Is Nothing Then
  c.Offset(0, 1) = Val(c.Offset(0, 1)) + 1
  End If
  fichier = Dir
Loop
End Sub
 

Bens7

XLDnaute Impliqué
Bonjour navre de ne pas être revenu sur le post pour remercier !!
cela fonctionne parfaitement voici mon code actuel :

VB:
Sub majlegume()

rep = "D:\MON DOSSIER\RESEAUX\EN COURS\"
fichier = Dir(rep)
Do While fichier <> ""
  tx = Left(fichier, Len(fichier) - 4)
For k = 1 To Len(tx)
If Not IsNumeric(Mid(tx, Len(tx) - k, 1)) Then
tx = Left(tx, Len(tx) - k)
Exit For
End If
Next
  Set C = Feuil2.UsedRange.Find(tx, lookat:=xlWhole)
  If Not C Is Nothing Then
  C.Offset(0, 1) = Val(C.Offset(0, 1)) + 1
  End If
  fichier = Dir
Loop
End Sub
Alors je me permet juste une petite modification suite a une insertion de fichier en copier coller :
J;ai bien de fichier :
Tomate1
Tomate2
Tomate3
Qui sont bien calcule .. mais j'ai aussi (suite a un copier coller (obligatoire)provenant d'un autre dossier):
Tomate1
Tomate1 (2)
Tomate1 (3)
Tomate2
Tomate2 (2)
Tomate2 (3)
Tomate3
Tomate3 (2)
Tomate3 (3)
donc j'ai besoin que ceux avec parenthèse soit comptabiliser également... merci pour vos lumières !!
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir à tous,

Un autre essai ?:
VB:
Private Sub CommandButton1_Click()
Dim dico, T, i&, j&
Dim F(), chemin, fichier, cat

Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = TextCompare
T = Worksheets("Feuil1").Range("a1").CurrentRegion
For i = 2 To UBound(T)
   For j = 1 To 5 Step 2
      If T(i, j) <> "" Then dico(T(i, j)) = 0
   Next j
Next i

chemin = ThisWorkbook.Path & "\RESEAUX\EN COURS\"
chemin = Replace(chemin, "\\", "\")
fichier = Dir(chemin & "*.txt")
Do Until fichier = ""
   fichier = Left(fichier, Len(fichier) - 4)
   For Each cat In dico.Keys
      If fichier Like cat & "#" & "*" Then dico(cat) = dico(cat) + 1
   Next cat
   fichier = Dir
Loop

For i = 2 To UBound(T)
   For j = 1 To 5 Step 2
      If T(i, j) <> "" Then T(i, j + 1) = dico(T(i, j))
   Next j
Next i
Worksheets("Feuil1").Range("a1").CurrentRegion = T
End Sub
 

Bens7

XLDnaute Impliqué
Bonsoir à tous,

Un autre essai ?:
VB:
Private Sub CommandButton1_Click()
Dim dico, T, i&, j&
Dim F(), chemin, fichier, cat

Set dico = CreateObject("scripting.dictionary")
dico.CompareMode = TextCompare
T = Worksheets("Feuil1").Range("a1").CurrentRegion
For i = 2 To UBound(T)
   For j = 1 To 5 Step 2
      If T(i, j) <> "" Then dico(T(i, j)) = 0
   Next j
Next i

chemin = ThisWorkbook.Path & "\RESEAUX\EN COURS\"
chemin = Replace(chemin, "\\", "\")
fichier = Dir(chemin & "*.txt")
Do Until fichier = ""
   fichier = Left(fichier, Len(fichier) - 4)
   For Each cat In dico.Keys
      If fichier Like cat & "#" & "*" Then dico(cat) = dico(cat) + 1
   Next cat
   fichier = Dir
Loop

For i = 2 To UBound(T)
   For j = 1 To 5 Step 2
      If T(i, j) <> "" Then T(i, j + 1) = dico(T(i, j))
   Next j
Next i
Worksheets("Feuil1").Range("a1").CurrentRegion = T
End Sub
 

Bens7

XLDnaute Impliqué
L'indice n'appartient pas a la selection :
If T(i, j) <> "" Then
Mon fichier test est dans : D:\MONDOSSIER\SOUSDOSSIER\test.xlsm
Mes fichiers text sont dans : D:\MONDOSSIER\RESEAUX\EN COURS\
 

Bens7

XLDnaute Impliqué
On peux pas juste readapter le Macro suivant :

VB:
Sub majlegume()

rep = "D:\MON DOSSIER\RESEAUX\EN COURS\"
fichier = Dir(rep)
Do While fichier <> ""
  tx = Left(fichier, Len(fichier) - 4)
For k = 1 To Len(tx)
If Not IsNumeric(Mid(tx, Len(tx) - k, 1)) Then
tx = Left(tx, Len(tx) - k)
Exit For
End If
Next
  Set C = Feuil2.UsedRange.Find(tx, lookat:=xlWhole)
  If Not C Is Nothing Then
  C.Offset(0, 1) = Val(C.Offset(0, 1)) + 1
  End If
  fichier = Dir
Loop
End Sub
Et je n'aurais qu'a change mes fichier text l'hors de la creation en mettant un espace après le mot exact du genre :
Tomate 1
Tomate 2
Tomate 3
Tomate 1 (2)
Tomate 1 (3)
Tomate 2
Tomate 2 (2)
Tomate 2 (3)
Tomate 3
Tomate 3 (2)
Tomate 3 (3)
Dans ce cas on calcule le nmb de fois "Tomate" uniquement peux importe la suite ...
P.,S : Attentons au cas Courge et Courgette par exemple comme la dit youky-bj plus haut.
 

youky(BJ)

XLDnaute Barbatruc
Bonjour à tous,
Attention je viens de faire cette macro avec le Bloc Note donc je n'ai rien testé.
En plus si j'ai compris.
Bruno
VB:
Sub majlegume()
rep = "D:\MON DOSSIER\RESEAUX\EN COURS\"
fichier = Dir(rep)
Do While fichier <> ""
  tx = split(fichier," ")(0)
  Set C = Feuil2.UsedRange.Find(tx, lookat:=xlWhole)
If Not C Is Nothing Then
if right(C.value,1)=")" then
  tx2=split(fichier,"(")(1)
  n=left(tx2,len(tx2)-5)
   C.Offset(0, 1))=replace(C.Offset(0, 1),"(" & n & ")","(" & n+1 & ")")
else
  C.Offset(0, 1) = Val(C.Offset(0, 1)) + 1
end if
End If
  fichier = Dir
Loop
End Sub
 

Bens7

XLDnaute Impliqué
Merci mais j'ai :
Erreur de Syntaxe :


C.Offset(0, 1))=replace(C.Offset(0, 1),"(" & n & ")","(" & n+1 & ")")
 

Bens7

XLDnaute Impliqué
Holala magnifique juste un petit souci dans votre précédent code :

VB:
Sub majlegume()
clearlegume ' efface les collones nombre
rep = "D:\MON DOSSIER\RESEAUX\EN COURS\"
fichier = Dir(rep)
Do While fichier <> ""
  tx = Left(fichier, Len(fichier) - 4)
For k = 1 To Len(tx)
If Not IsNumeric(Mid(tx, Len(tx) - k, 1)) Then
tx = Left(tx, Len(tx) - k)
Exit For
End If
Next
  Set C = Feuil2.UsedRange.Find(tx, lookat:=xlWhole)
  If Not C Is Nothing Then
  C.Offset(0, 1) = Val(C.Offset(0, 1)) + 1
  End If
  fichier = Dir
Loop

End Sub
J'avais créer plusieurs colonnes de catégories différentes et je ne sait comment le calcul se faisait aussi sur les colonnes suivantes ...
du coup la non ... (et je ne sais pas comment l'adapter) voici le fichier ci joint plus clair .. et il est possible que je créer d'autre colonnes a l'avenir ... faudrait faire une truc du style :
"Loop si dans la ligne 1 y a une entête ..." (enfin une colonne sur 2... ou sinon je rajoute un mot dans l’entête nombre)
 

Fichiers joints

Bens7

XLDnaute Impliqué
Désolé ! Ça marche aussi !!
Merci !!!!!
Pourriez vous juste m’éclairer pourquoi ça marche lolll (comment il sait quand c'est une colonne a mettre les nombre et une colonne de texte...)
 

youky(BJ)

XLDnaute Barbatruc
Ravi que tout fonctionne
Explications:
la variable "tx" exemple renvoi Tomates 1 (2)
le code Set C = Feuil2.UsedRange.Find(tx, lookat:=xlWhole) va chercher tx
si trouvé C est la cellule contenant Tomates 1 (2)
et C.offset(0,1) est la cellule C décalée d'une colonne à droite
si j'avais voulu la colonne à gauche à la place de 1 j'aurai mis -1 et le 0 est la ligne
pour savoir si Tomates 1 ou Tomates 1 (2) j'utilise…..if right(C.value,1)=")" then
si la dernière lettre est ")"
Les noms de fichiers doivent avoir un espace avant le chiffre et ne doivent pas avoir d'espace avant le chiffre
exemple ne pas écrire "Choux fleur 1" écrire "Choux-fleur 1"
Ben voila
Bruno
 

Bens7

XLDnaute Impliqué
Ravi que tout fonctionne
Les noms de fichiers doivent avoir un espace avant le chiffre et ne doivent pas avoir d'espace avant le chiffre
exemple ne pas écrire "Choux fleur 1" écrire "Choux-fleur 1"
Ben voila
Bruno
Ha heureusement que j'ai demander ! Du coup je viens de m'apercevoir d'un problème, mes cellules ne comportent en réalité pas des noms de fruit mais des nom de Ville ... du coup il y a effectivement des villes avec un espace : par exemple : Les Paccots
Du coup ça ne marchera pas ? je peux également créer un buteur dans mes fichier texte du genre :
Les Paccorts#1, Les Paccorts#1 (2),Les Paccorts#1 (3)
Et la on recherche et calcul tous ce qui précédé "#"
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas