Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichDenis
Tu dois définir dans la procédure, le répertoire et l'expression recherchée ....
Cette procédure boucle sur tous les fichiers ayant une extension ".txt" dans le répertoire que tu lui mentionneras et t'afficheras dans un nouveau classeur ceci pour les classeurs seulement où il y a au moins une occurrence du mot recherché Colonne A : Nom du fichier Colonne B : Nombre d'occurrence du mot recherché Colonne C : Le mot recherché
Si tu veux avoir la liste de tous les fichiers nonobstant la présence du mot recherché, tu enlèves ce test (seulement ces 2 lignes de code) dans la procédure :
If Nb <> 0 Then
End if
'------------------------------- Sub test()
Dim LeFichier As String, Texte As String Dim Repertoire As String, Nb As Long Dim FS As Object, F As Object, Wk As Workbook Dim MotChercher As String, A As Long
'à toi de définir le mot à rechercher MotChercher = "lancement" ' à déterminer
'à toi de définir le répertoire où se fait la recherche Repertoire = "c:Atravail" ' à déterminer
'Ajoute un classeur où les résultats apparaîtront Set Wk = Workbooks.Add
'Pour les en-têtes de colonnes de la feuille résultat With Wk.Worksheets(1) .Name = "Synthèse" .Range("A1") = "Nom Du Fichier" .Range("B1") = "Nombre occurrences" .Range("C1") = "Mot recherché" .Range("A1:C1").Font.Bold = True
End With A = A + 1
'Un petit test pour savoir si le répertoire que tu as 'défini existe réellement If Dir(Repertoire, vbDirectory) <> "" Then Set FS = CreateObject("Scripting.FileSystemObject") LeFichier = Dir(Repertoire & "*.txt") Do Until LeFichier = "" Set F = FS.OpenTextFile(Repertoire & LeFichier, 1) 'La variable Texte contient tout le texte contenu dans le fichier Texte = LCase(F.readall) 'La ligne suivante calcule le nombre d'occurrence du fichier texte Nb = Nb + ((Len(Texte) - (Len(Application.Substitute _ (Texte, MotChercher, ""))))) / Len(MotChercher) 'fermeture du fichier texte F.Close Texte = "" ' vide la variable du texte pour le fichier suivant If Nb <> 0 Then A = A + 1 'écriture du résultat dans le fichier With Wk.Worksheets(1) .Range("A" & A) = LeFichier .Range("B" & A) = Nb .Range("C" & A) = MotChercher End With End If 'regarde la fonction Dir() c'est elle qui permet d'appeler le fichier suivant LeFichier = Dir() Loop Wk.Worksheets(1).Range("A1:C1").EntireColumn.AutoFit 'Sauvegarde du fichier dans le répertoire de tes fichiers texte. 'P.S. Il ne doit pas y avoir un fichier portant déjà ce nom dans ce répertoire Wk.SaveAs Repertoire & "Synthèse.xls" Else 'si le répertoire n'est pas valide... Wk.Close False MsgBox "Ce " & Repertoire & " est introuvable" End If End Sub '-------------------------------
Tu dois définir dans la procédure, le répertoire
et l'expression recherchée ....
Cette procédure boucle sur tous les fichiers ayant une extension ".txt"
dans le répertoire que tu lui mentionneras et t'afficheras dans un
nouveau classeur ceci pour les classeurs seulement où il y a au moins
une occurrence du mot recherché
Colonne A : Nom du fichier
Colonne B : Nombre d'occurrence du mot recherché
Colonne C : Le mot recherché
Si tu veux avoir la liste de tous les fichiers nonobstant la présence
du mot recherché, tu enlèves ce test (seulement ces 2 lignes de code)
dans la procédure :
If Nb <> 0 Then
End if
'-------------------------------
Sub test()
Dim LeFichier As String, Texte As String
Dim Repertoire As String, Nb As Long
Dim FS As Object, F As Object, Wk As Workbook
Dim MotChercher As String, A As Long
'à toi de définir le mot à rechercher
MotChercher = "lancement" ' à déterminer
'à toi de définir le répertoire où se fait la recherche
Repertoire = "c:Atravail" ' à déterminer
'Ajoute un classeur où les résultats apparaîtront
Set Wk = Workbooks.Add
'Pour les en-têtes de colonnes de la feuille résultat
With Wk.Worksheets(1)
.Name = "Synthèse"
.Range("A1") = "Nom Du Fichier"
.Range("B1") = "Nombre occurrences"
.Range("C1") = "Mot recherché"
.Range("A1:C1").Font.Bold = True
End With
A = A + 1
'Un petit test pour savoir si le répertoire que tu as
'défini existe réellement
If Dir(Repertoire, vbDirectory) <> "" Then
Set FS = CreateObject("Scripting.FileSystemObject")
LeFichier = Dir(Repertoire & "*.txt")
Do Until LeFichier = ""
Set F = FS.OpenTextFile(Repertoire & LeFichier, 1)
'La variable Texte contient tout le texte contenu dans le fichier
Texte = LCase(F.readall)
'La ligne suivante calcule le nombre d'occurrence du fichier texte
Nb = Nb + ((Len(Texte) - (Len(Application.Substitute _
(Texte, MotChercher, ""))))) / Len(MotChercher)
'fermeture du fichier texte
F.Close
Texte = "" ' vide la variable du texte pour le fichier suivant
If Nb <> 0 Then
A = A + 1
'écriture du résultat dans le fichier
With Wk.Worksheets(1)
.Range("A" & A) = LeFichier
.Range("B" & A) = Nb
.Range("C" & A) = MotChercher
End With
End If
'regarde la fonction Dir() c'est elle qui permet d'appeler le fichier suivant
LeFichier = Dir()
Loop
Wk.Worksheets(1).Range("A1:C1").EntireColumn.AutoFit
'Sauvegarde du fichier dans le répertoire de tes fichiers texte.
'P.S. Il ne doit pas y avoir un fichier portant déjà ce nom dans ce répertoire
Wk.SaveAs Repertoire & "Synthèse.xls"
Else
'si le répertoire n'est pas valide...
Wk.Close False
MsgBox "Ce " & Repertoire & " est introuvable"
End If
End Sub
'-------------------------------
<documentsyassine@gmail.com> a écrit dans le message de news:
cb86e2b0-6e01-4bca-9caa-7e909b3e8f3b@e25g2000prg.googlegroups.com...
bonjour,
Tu dois définir dans la procédure, le répertoire et l'expression recherchée ....
Cette procédure boucle sur tous les fichiers ayant une extension ".txt" dans le répertoire que tu lui mentionneras et t'afficheras dans un nouveau classeur ceci pour les classeurs seulement où il y a au moins une occurrence du mot recherché Colonne A : Nom du fichier Colonne B : Nombre d'occurrence du mot recherché Colonne C : Le mot recherché
Si tu veux avoir la liste de tous les fichiers nonobstant la présence du mot recherché, tu enlèves ce test (seulement ces 2 lignes de code) dans la procédure :
If Nb <> 0 Then
End if
'------------------------------- Sub test()
Dim LeFichier As String, Texte As String Dim Repertoire As String, Nb As Long Dim FS As Object, F As Object, Wk As Workbook Dim MotChercher As String, A As Long
'à toi de définir le mot à rechercher MotChercher = "lancement" ' à déterminer
'à toi de définir le répertoire où se fait la recherche Repertoire = "c:Atravail" ' à déterminer
'Ajoute un classeur où les résultats apparaîtront Set Wk = Workbooks.Add
'Pour les en-têtes de colonnes de la feuille résultat With Wk.Worksheets(1) .Name = "Synthèse" .Range("A1") = "Nom Du Fichier" .Range("B1") = "Nombre occurrences" .Range("C1") = "Mot recherché" .Range("A1:C1").Font.Bold = True
End With A = A + 1
'Un petit test pour savoir si le répertoire que tu as 'défini existe réellement If Dir(Repertoire, vbDirectory) <> "" Then Set FS = CreateObject("Scripting.FileSystemObject") LeFichier = Dir(Repertoire & "*.txt") Do Until LeFichier = "" Set F = FS.OpenTextFile(Repertoire & LeFichier, 1) 'La variable Texte contient tout le texte contenu dans le fichier Texte = LCase(F.readall) 'La ligne suivante calcule le nombre d'occurrence du fichier texte Nb = Nb + ((Len(Texte) - (Len(Application.Substitute _ (Texte, MotChercher, ""))))) / Len(MotChercher) 'fermeture du fichier texte F.Close Texte = "" ' vide la variable du texte pour le fichier suivant If Nb <> 0 Then A = A + 1 'écriture du résultat dans le fichier With Wk.Worksheets(1) .Range("A" & A) = LeFichier .Range("B" & A) = Nb .Range("C" & A) = MotChercher End With End If 'regarde la fonction Dir() c'est elle qui permet d'appeler le fichier suivant LeFichier = Dir() Loop Wk.Worksheets(1).Range("A1:C1").EntireColumn.AutoFit 'Sauvegarde du fichier dans le répertoire de tes fichiers texte. 'P.S. Il ne doit pas y avoir un fichier portant déjà ce nom dans ce répertoire Wk.SaveAs Repertoire & "Synthèse.xls" Else 'si le répertoire n'est pas valide... Wk.Close False MsgBox "Ce " & Repertoire & " est introuvable" End If End Sub '-------------------------------
merci pour les explications apparament elle sont trés utiles toutefois, j'ai rien compris autrement dit j'ai mal expliquer mon probléme alors ce dernier ce présente comme suit :
je dispose d'une base de données composées de +re colone je désire mettre en place un filre ki me permettra de faire ressourtir des résultats issu de 2 colonne
par exepl
soit les colonne suivante : *Code employé *sexe *date naissance *niveau éducation(en années) *catégorie salaire actuel *salaire début *anciennté (mois)
je désire avoir les : cadre femme ayant un salaire entre x & y et cadre homme ayant un salaire entre x & y
marci de m'instrure sur cette demande
salut
merci pour les explications apparament elle sont trés utiles
toutefois, j'ai rien compris
autrement dit j'ai mal expliquer mon probléme
alors ce dernier ce présente comme suit :
je dispose d'une base de données composées de +re colone
je désire mettre en place un filre ki me permettra de faire ressourtir
des résultats issu de 2 colonne
par exepl
soit les colonne suivante :
*Code employé
*sexe
*date naissance
*niveau éducation(en années)
*catégorie salaire actuel
*salaire début
*anciennté (mois)
je désire avoir les :
cadre femme ayant un salaire entre x & y
et
cadre homme ayant un salaire entre x & y
merci pour les explications apparament elle sont trés utiles toutefois, j'ai rien compris autrement dit j'ai mal expliquer mon probléme alors ce dernier ce présente comme suit :
je dispose d'une base de données composées de +re colone je désire mettre en place un filre ki me permettra de faire ressourtir des résultats issu de 2 colonne
par exepl
soit les colonne suivante : *Code employé *sexe *date naissance *niveau éducation(en années) *catégorie salaire actuel *salaire début *anciennté (mois)
je désire avoir les : cadre femme ayant un salaire entre x & y et cadre homme ayant un salaire entre x & y
marci de m'instrure sur cette demande
Brunos
je dispose d'une base de données composées de +re colone je désire mettre en place un filre ki me permettra de faire ressourtir des résultats issu de 2 colonne
Il suffit d'activer le filtre automatique. Sélectionner les titres de colonne, menu Données | Filtre auto. Ensuite aller dans les colonnes que tu veux filtrer et cliquer sur le petit triangle-pointe-en-bas pour définir tes filtres.
-- Brunos
je dispose d'une base de données composées de +re colone
je désire mettre en place un filre ki me permettra de faire ressourtir
des résultats issu de 2 colonne
Il suffit d'activer le filtre automatique.
Sélectionner les titres de colonne, menu Données | Filtre auto.
Ensuite aller dans les colonnes que tu veux filtrer et cliquer sur le
petit triangle-pointe-en-bas pour définir tes filtres.
je dispose d'une base de données composées de +re colone je désire mettre en place un filre ki me permettra de faire ressourtir des résultats issu de 2 colonne
Il suffit d'activer le filtre automatique. Sélectionner les titres de colonne, menu Données | Filtre auto. Ensuite aller dans les colonnes que tu veux filtrer et cliquer sur le petit triangle-pointe-en-bas pour définir tes filtres.
-- Brunos
MichDenis
Cette procédure va mettre dans le même classeur toutes tes données dans le même classeur .xls... les données à la suite des autres... évidemment tes fichiers texte doivent avoir la même struture
Tu détermines le répertoire d'où sont tes fichiers ... dans l'exemple qui suit, la colonne 3 représente des dates
Les données seront copiées dans le même classeur où tu copieras cette procédure et ce dans la feuille nommée "Feuil1"
à partir du nouveau classeur, tu pourras faire les filtres que tu désires.
'-------------------------------------- Sub ouvrirlefichiertexte() Dim I As Long, x As Long Dim Ligne As String, A As Integer Dim NoLig As Long
Application.ScreenUpdating = False Do Until lefichier = "" A = A + 1 NoLig = NoLig + 1 With Workbooks If A = 1 Then .OpenText lefichier, startrow:=1 Else .OpenText lefichier, startrow:=2 End If Set wk = ActiveWorkbook With ThisWorkbook With .Worksheets("Feuil1") If NoLig > 1 Then NoLig = .Range("a65536").End(xlUp)(2).Row End If wk.Worksheets(1).UsedRange.Copy .Range("A" & NoLig) End With End With End With wk.Close False lefichier = Dir() Loop Application.DisplayAlerts = False With ThisWorkbook With .Worksheets("Feuil1") .Columns(1).TextToColumns DataType:=xlDelimited, comma:=True, _ ConsecutiveDelimiter:=True, _ fieldInfo:=Array(Array(3, 3)) .Range("A1:H1").EntireColumn.AutoFit End With End With
End Sub '--------------------------------------
a écrit dans le message de news:
salut
merci pour les explications apparament elle sont trés utiles toutefois, j'ai rien compris autrement dit j'ai mal expliquer mon probléme alors ce dernier ce présente comme suit :
je dispose d'une base de données composées de +re colone je désire mettre en place un filre ki me permettra de faire ressourtir des résultats issu de 2 colonne
par exepl
soit les colonne suivante : *Code employé *sexe *date naissance *niveau éducation(en années) *catégorie salaire actuel *salaire début *anciennté (mois)
je désire avoir les : cadre femme ayant un salaire entre x & y et cadre homme ayant un salaire entre x & y
marci de m'instrure sur cette demande
Cette procédure va mettre dans le même classeur toutes
tes données dans le même classeur .xls... les données
à la suite des autres... évidemment tes fichiers texte doivent
avoir la même struture
Tu détermines le répertoire d'où sont tes fichiers ...
dans l'exemple qui suit, la colonne 3 représente des dates
Les données seront copiées dans le même classeur où
tu copieras cette procédure et ce dans la feuille nommée "Feuil1"
à partir du nouveau classeur, tu pourras faire les filtres que tu désires.
'--------------------------------------
Sub ouvrirlefichiertexte()
Dim I As Long, x As Long
Dim Ligne As String, A As Integer
Dim NoLig As Long
Application.ScreenUpdating = False
Do Until lefichier = ""
A = A + 1
NoLig = NoLig + 1
With Workbooks
If A = 1 Then
.OpenText lefichier, startrow:=1
Else
.OpenText lefichier, startrow:=2
End If
Set wk = ActiveWorkbook
With ThisWorkbook
With .Worksheets("Feuil1")
If NoLig > 1 Then
NoLig = .Range("a65536").End(xlUp)(2).Row
End If
wk.Worksheets(1).UsedRange.Copy .Range("A" & NoLig)
End With
End With
End With
wk.Close False
lefichier = Dir()
Loop
Application.DisplayAlerts = False
With ThisWorkbook
With .Worksheets("Feuil1")
.Columns(1).TextToColumns DataType:=xlDelimited, comma:=True, _
ConsecutiveDelimiter:=True, _
fieldInfo:=Array(Array(3, 3))
.Range("A1:H1").EntireColumn.AutoFit
End With
End With
End Sub
'--------------------------------------
<documentsyassine@gmail.com> a écrit dans le message de news:
f726d5fe-6f60-4d81-98c0-e59db7c4e626@s13g2000prd.googlegroups.com...
salut
merci pour les explications apparament elle sont trés utiles
toutefois, j'ai rien compris
autrement dit j'ai mal expliquer mon probléme
alors ce dernier ce présente comme suit :
je dispose d'une base de données composées de +re colone
je désire mettre en place un filre ki me permettra de faire ressourtir
des résultats issu de 2 colonne
par exepl
soit les colonne suivante :
*Code employé
*sexe
*date naissance
*niveau éducation(en années)
*catégorie salaire actuel
*salaire début
*anciennté (mois)
je désire avoir les :
cadre femme ayant un salaire entre x & y
et
cadre homme ayant un salaire entre x & y
Cette procédure va mettre dans le même classeur toutes tes données dans le même classeur .xls... les données à la suite des autres... évidemment tes fichiers texte doivent avoir la même struture
Tu détermines le répertoire d'où sont tes fichiers ... dans l'exemple qui suit, la colonne 3 représente des dates
Les données seront copiées dans le même classeur où tu copieras cette procédure et ce dans la feuille nommée "Feuil1"
à partir du nouveau classeur, tu pourras faire les filtres que tu désires.
'-------------------------------------- Sub ouvrirlefichiertexte() Dim I As Long, x As Long Dim Ligne As String, A As Integer Dim NoLig As Long
Application.ScreenUpdating = False Do Until lefichier = "" A = A + 1 NoLig = NoLig + 1 With Workbooks If A = 1 Then .OpenText lefichier, startrow:=1 Else .OpenText lefichier, startrow:=2 End If Set wk = ActiveWorkbook With ThisWorkbook With .Worksheets("Feuil1") If NoLig > 1 Then NoLig = .Range("a65536").End(xlUp)(2).Row End If wk.Worksheets(1).UsedRange.Copy .Range("A" & NoLig) End With End With End With wk.Close False lefichier = Dir() Loop Application.DisplayAlerts = False With ThisWorkbook With .Worksheets("Feuil1") .Columns(1).TextToColumns DataType:=xlDelimited, comma:=True, _ ConsecutiveDelimiter:=True, _ fieldInfo:=Array(Array(3, 3)) .Range("A1:H1").EntireColumn.AutoFit End With End With
End Sub '--------------------------------------
a écrit dans le message de news:
salut
merci pour les explications apparament elle sont trés utiles toutefois, j'ai rien compris autrement dit j'ai mal expliquer mon probléme alors ce dernier ce présente comme suit :
je dispose d'une base de données composées de +re colone je désire mettre en place un filre ki me permettra de faire ressourtir des résultats issu de 2 colonne
par exepl
soit les colonne suivante : *Code employé *sexe *date naissance *niveau éducation(en années) *catégorie salaire actuel *salaire début *anciennté (mois)
je désire avoir les : cadre femme ayant un salaire entre x & y et cadre homme ayant un salaire entre x & y