Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel, j'arrive a
rechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds les
cellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel, j'arrive a
rechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds les
cellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel, j'arrive a
rechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds les
cellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
Salut Daredevil,
L'exemple est avec ADO mais sans référence car en liaison tardive.
Tu peux supprimer la fonction "Controle" pour raccourcir le code si tu est
sûr de la plage que tu passes (supprime aussi l'appel dans la proc
"LireModifierEnrg"). Pour tester, exécute la proc "LireModifier" en ayant
pris soins d'adapter à tes valeurs (plage, chemin du classeur, non de la
feuille de recherche, nom de la feuille de récup). Le code parraît
compliqué, mais il est en fait très simple, donc pas de panique :
Private Sub ConnecterCLasseur(ConnectCL As Object, _
Fichier As String, _
Entete As Boolean, _
LectureSeule As Boolean, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
'HDR > YES ou NO = entêtes de colonnes
'IMEX > 1 lecture seule, 2 lecture/écriture
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & IIf(Entete = True, "YES", "NO") & _
";IMEX=" & IIf(LectureSeule = True, 1, 2) & ";"""
End Sub
Sub LireModifierEnrg(CheminClasseurCible As String, _
NomFeuille As String, _
Plage As String, _
ChaineSQL As String, _
Entete As Boolean, _
TableauRetour, _
Optional Remplacer, _
Optional NomChamp)
'TableauRetour étant passé en reference, il contiendra
'les valeurs de la plage
Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim I As Integer, J As Integer
'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage
'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement pour effectuer la recherche
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Plage & "` " & ChaineSQL, ConnectCL
'sans entête, retourne la plage spécifiée
' .Open "SELECT * FROM `" & NomFeuille & "$" & _
' Plage & "` ", ConnectCL
If .RecordCount = 0 Then
MsgBox "Ancun enregistrement trouvé !"
Exit Sub
End If
.MoveFirst
'effectue la modif si les valeurs ont été passées en paramètre
'sinon retourne les enregistrements trouvés dans le tableau
If Not IsMissing(Remplacer) And Not IsMissing(NomChamp) Then
If MsgBox("Modifier les enregistrements ?", _
vbYesNo + vbQuestion) = vbNo Then Exit Sub
Do While Not .EOF
.Fields(NomChamp).Value = Remplacer
.Update
.MoveNext
Loop
Else
If Range(Plage).Cells.Count > 1 Then
ReDim TableauRetour( _
1 To .RecordCount, _
1 To .Fields.Count)
.MoveFirst
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
TableauRetour(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
Else
ReDim TableauRetour(1 To 1)
TableauRetour(1) = .Fields(0).Value
End If
End If
End With
ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub
Private Function Controle(CheminCible As String, _
Plage As String) As Boolean
Dim Factice As Range
'effectue un contrôle de validité de la plage
Controle = True
If Plage = "" Then
MsgBox "La plage passée en argument est vide !"
Controle = False
Exit Function
End If
If Dir(CheminCible) = "" Then
MsgBox "Le fichier '" & CheminCible & "' est introuvable !"
Controle = False
Exit Function
End If
If InStr(Plage, ";") <> 0 Then
MsgBox "La plage doit être contiguë !"
Controle = False
Exit Function
End If
On Error Resume Next
Set Factice = Range(Plage)
If Err.Number <> 0 Then
MsgBox "Erreur dans l'orthographe de la plage !" _
& vbCrLf & "Plage non valide > " & Plage
Controle = False
End If
Set Factice = Nothing
On Error GoTo 0
End Function
Sub LireModifier()
Dim Tbl
Dim Chemin As String
Dim NomFeuille As String
Dim Entete As Boolean
Dim ChaineSQL As String
Dim Rng As String
Dim Remplacer
'modifier le chemin du classeur cible
Chemin = "D:Classeur1.xls"
'feuille dans laquelle effectuer les recherches
NomFeuille = "Feuil1"
'plage de recherche dans le classeur cible
Rng = "A1:F50"
'si la plage de recherche n'a pas d'entête de colonne
'mettre à false, dans ce cas, retoure toute la plage
Entete = True
'indiquer le valeur de remplacement si tu veux modifier
Remplacer = ""
'valeur cherchée
'le signe % est un jocker qui remplace 1 ou plusieurs caractères
'le signe _ est un jocker qui remplace seulement un caractère
'les crochets [ae], avec les lettres à l'intérieur, s'utilisent
'comme le signe _ mais avec les lettres indiquées
'Cr[oia]ps retourne Crips, Crops, Craps
ChaineSQL = "WHERE Nom LIKE 'Cr[oia]ps' "
LireModifierEnrg Chemin, NomFeuille, Rng, ChaineSQL, Entete, Tbl
'adapte ici en fonction de ce que tu veux faire des valeurs retournées
'dans ce cas ci, elles sont inscritent dans "feuil2" du classeur actif
On Error Resume Next
If Remplacer = "" Then
With ThisWorkbook.Worksheets("Feuil2")
If Range(Rng).Cells.Count > 1 Then
.Range(.[A1], .Cells(UBound(Tbl, 1), _
UBound(Tbl, 2))).Value = Tbl
Else
.Range("A1").Value = Tbl(1)
End If
End With
Erase Tbl
End If
End Sub
Reviens si problèmes.
Hervé.
"Dardevil" a écrit dans le message news:Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel, j'arrive
a
rechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds
les
cellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
Salut Daredevil,
L'exemple est avec ADO mais sans référence car en liaison tardive.
Tu peux supprimer la fonction "Controle" pour raccourcir le code si tu est
sûr de la plage que tu passes (supprime aussi l'appel dans la proc
"LireModifierEnrg"). Pour tester, exécute la proc "LireModifier" en ayant
pris soins d'adapter à tes valeurs (plage, chemin du classeur, non de la
feuille de recherche, nom de la feuille de récup). Le code parraît
compliqué, mais il est en fait très simple, donc pas de panique :
Private Sub ConnecterCLasseur(ConnectCL As Object, _
Fichier As String, _
Entete As Boolean, _
LectureSeule As Boolean, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
'HDR > YES ou NO = entêtes de colonnes
'IMEX > 1 lecture seule, 2 lecture/écriture
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & IIf(Entete = True, "YES", "NO") & _
";IMEX=" & IIf(LectureSeule = True, 1, 2) & ";"""
End Sub
Sub LireModifierEnrg(CheminClasseurCible As String, _
NomFeuille As String, _
Plage As String, _
ChaineSQL As String, _
Entete As Boolean, _
TableauRetour, _
Optional Remplacer, _
Optional NomChamp)
'TableauRetour étant passé en reference, il contiendra
'les valeurs de la plage
Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim I As Integer, J As Integer
'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage
'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement pour effectuer la recherche
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Plage & "` " & ChaineSQL, ConnectCL
'sans entête, retourne la plage spécifiée
' .Open "SELECT * FROM `" & NomFeuille & "$" & _
' Plage & "` ", ConnectCL
If .RecordCount = 0 Then
MsgBox "Ancun enregistrement trouvé !"
Exit Sub
End If
.MoveFirst
'effectue la modif si les valeurs ont été passées en paramètre
'sinon retourne les enregistrements trouvés dans le tableau
If Not IsMissing(Remplacer) And Not IsMissing(NomChamp) Then
If MsgBox("Modifier les enregistrements ?", _
vbYesNo + vbQuestion) = vbNo Then Exit Sub
Do While Not .EOF
.Fields(NomChamp).Value = Remplacer
.Update
.MoveNext
Loop
Else
If Range(Plage).Cells.Count > 1 Then
ReDim TableauRetour( _
1 To .RecordCount, _
1 To .Fields.Count)
.MoveFirst
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
TableauRetour(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
Else
ReDim TableauRetour(1 To 1)
TableauRetour(1) = .Fields(0).Value
End If
End If
End With
ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub
Private Function Controle(CheminCible As String, _
Plage As String) As Boolean
Dim Factice As Range
'effectue un contrôle de validité de la plage
Controle = True
If Plage = "" Then
MsgBox "La plage passée en argument est vide !"
Controle = False
Exit Function
End If
If Dir(CheminCible) = "" Then
MsgBox "Le fichier '" & CheminCible & "' est introuvable !"
Controle = False
Exit Function
End If
If InStr(Plage, ";") <> 0 Then
MsgBox "La plage doit être contiguë !"
Controle = False
Exit Function
End If
On Error Resume Next
Set Factice = Range(Plage)
If Err.Number <> 0 Then
MsgBox "Erreur dans l'orthographe de la plage !" _
& vbCrLf & "Plage non valide > " & Plage
Controle = False
End If
Set Factice = Nothing
On Error GoTo 0
End Function
Sub LireModifier()
Dim Tbl
Dim Chemin As String
Dim NomFeuille As String
Dim Entete As Boolean
Dim ChaineSQL As String
Dim Rng As String
Dim Remplacer
'modifier le chemin du classeur cible
Chemin = "D:Classeur1.xls"
'feuille dans laquelle effectuer les recherches
NomFeuille = "Feuil1"
'plage de recherche dans le classeur cible
Rng = "A1:F50"
'si la plage de recherche n'a pas d'entête de colonne
'mettre à false, dans ce cas, retoure toute la plage
Entete = True
'indiquer le valeur de remplacement si tu veux modifier
Remplacer = ""
'valeur cherchée
'le signe % est un jocker qui remplace 1 ou plusieurs caractères
'le signe _ est un jocker qui remplace seulement un caractère
'les crochets [ae], avec les lettres à l'intérieur, s'utilisent
'comme le signe _ mais avec les lettres indiquées
'Cr[oia]ps retourne Crips, Crops, Craps
ChaineSQL = "WHERE Nom LIKE 'Cr[oia]ps' "
LireModifierEnrg Chemin, NomFeuille, Rng, ChaineSQL, Entete, Tbl
'adapte ici en fonction de ce que tu veux faire des valeurs retournées
'dans ce cas ci, elles sont inscritent dans "feuil2" du classeur actif
On Error Resume Next
If Remplacer = "" Then
With ThisWorkbook.Worksheets("Feuil2")
If Range(Rng).Cells.Count > 1 Then
.Range(.[A1], .Cells(UBound(Tbl, 1), _
UBound(Tbl, 2))).Value = Tbl
Else
.Range("A1").Value = Tbl(1)
End If
End With
Erase Tbl
End If
End Sub
Reviens si problèmes.
Hervé.
"Dardevil" <ggaudfroy@free.fr> a écrit dans le message news:
eEiGS4orDHA.540@tk2msftngp13.phx.gbl...
Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel, j'arrive
a
rechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds
les
cellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
Salut Daredevil,
L'exemple est avec ADO mais sans référence car en liaison tardive.
Tu peux supprimer la fonction "Controle" pour raccourcir le code si tu est
sûr de la plage que tu passes (supprime aussi l'appel dans la proc
"LireModifierEnrg"). Pour tester, exécute la proc "LireModifier" en ayant
pris soins d'adapter à tes valeurs (plage, chemin du classeur, non de la
feuille de recherche, nom de la feuille de récup). Le code parraît
compliqué, mais il est en fait très simple, donc pas de panique :
Private Sub ConnecterCLasseur(ConnectCL As Object, _
Fichier As String, _
Entete As Boolean, _
LectureSeule As Boolean, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
'HDR > YES ou NO = entêtes de colonnes
'IMEX > 1 lecture seule, 2 lecture/écriture
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & IIf(Entete = True, "YES", "NO") & _
";IMEX=" & IIf(LectureSeule = True, 1, 2) & ";"""
End Sub
Sub LireModifierEnrg(CheminClasseurCible As String, _
NomFeuille As String, _
Plage As String, _
ChaineSQL As String, _
Entete As Boolean, _
TableauRetour, _
Optional Remplacer, _
Optional NomChamp)
'TableauRetour étant passé en reference, il contiendra
'les valeurs de la plage
Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim I As Integer, J As Integer
'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage
'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement pour effectuer la recherche
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Plage & "` " & ChaineSQL, ConnectCL
'sans entête, retourne la plage spécifiée
' .Open "SELECT * FROM `" & NomFeuille & "$" & _
' Plage & "` ", ConnectCL
If .RecordCount = 0 Then
MsgBox "Ancun enregistrement trouvé !"
Exit Sub
End If
.MoveFirst
'effectue la modif si les valeurs ont été passées en paramètre
'sinon retourne les enregistrements trouvés dans le tableau
If Not IsMissing(Remplacer) And Not IsMissing(NomChamp) Then
If MsgBox("Modifier les enregistrements ?", _
vbYesNo + vbQuestion) = vbNo Then Exit Sub
Do While Not .EOF
.Fields(NomChamp).Value = Remplacer
.Update
.MoveNext
Loop
Else
If Range(Plage).Cells.Count > 1 Then
ReDim TableauRetour( _
1 To .RecordCount, _
1 To .Fields.Count)
.MoveFirst
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
TableauRetour(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
Else
ReDim TableauRetour(1 To 1)
TableauRetour(1) = .Fields(0).Value
End If
End If
End With
ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub
Private Function Controle(CheminCible As String, _
Plage As String) As Boolean
Dim Factice As Range
'effectue un contrôle de validité de la plage
Controle = True
If Plage = "" Then
MsgBox "La plage passée en argument est vide !"
Controle = False
Exit Function
End If
If Dir(CheminCible) = "" Then
MsgBox "Le fichier '" & CheminCible & "' est introuvable !"
Controle = False
Exit Function
End If
If InStr(Plage, ";") <> 0 Then
MsgBox "La plage doit être contiguë !"
Controle = False
Exit Function
End If
On Error Resume Next
Set Factice = Range(Plage)
If Err.Number <> 0 Then
MsgBox "Erreur dans l'orthographe de la plage !" _
& vbCrLf & "Plage non valide > " & Plage
Controle = False
End If
Set Factice = Nothing
On Error GoTo 0
End Function
Sub LireModifier()
Dim Tbl
Dim Chemin As String
Dim NomFeuille As String
Dim Entete As Boolean
Dim ChaineSQL As String
Dim Rng As String
Dim Remplacer
'modifier le chemin du classeur cible
Chemin = "D:Classeur1.xls"
'feuille dans laquelle effectuer les recherches
NomFeuille = "Feuil1"
'plage de recherche dans le classeur cible
Rng = "A1:F50"
'si la plage de recherche n'a pas d'entête de colonne
'mettre à false, dans ce cas, retoure toute la plage
Entete = True
'indiquer le valeur de remplacement si tu veux modifier
Remplacer = ""
'valeur cherchée
'le signe % est un jocker qui remplace 1 ou plusieurs caractères
'le signe _ est un jocker qui remplace seulement un caractère
'les crochets [ae], avec les lettres à l'intérieur, s'utilisent
'comme le signe _ mais avec les lettres indiquées
'Cr[oia]ps retourne Crips, Crops, Craps
ChaineSQL = "WHERE Nom LIKE 'Cr[oia]ps' "
LireModifierEnrg Chemin, NomFeuille, Rng, ChaineSQL, Entete, Tbl
'adapte ici en fonction de ce que tu veux faire des valeurs retournées
'dans ce cas ci, elles sont inscritent dans "feuil2" du classeur actif
On Error Resume Next
If Remplacer = "" Then
With ThisWorkbook.Worksheets("Feuil2")
If Range(Rng).Cells.Count > 1 Then
.Range(.[A1], .Cells(UBound(Tbl, 1), _
UBound(Tbl, 2))).Value = Tbl
Else
.Range("A1").Value = Tbl(1)
End If
End With
Erase Tbl
End If
End Sub
Reviens si problèmes.
Hervé.
"Dardevil" a écrit dans le message news:Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel, j'arrive
a
rechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds
les
cellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
ca marche pas...
en fait comment ma question c comment rechercher une valeur dans un
fichier
fermé, puis en retirer son adresse de cellule?
merci
"Hervé" a écrit dans le message de
news:Salut Daredevil,
L'exemple est avec ADO mais sans référence car en liaison tardive.
Tu peux supprimer la fonction "Controle" pour raccourcir le code si tu
est
sûr de la plage que tu passes (supprime aussi l'appel dans la proc
"LireModifierEnrg"). Pour tester, exécute la proc "LireModifier" en
ayant
pris soins d'adapter à tes valeurs (plage, chemin du classeur, non de la
feuille de recherche, nom de la feuille de récup). Le code parraît
compliqué, mais il est en fait très simple, donc pas de panique :
Private Sub ConnecterCLasseur(ConnectCL As Object, _
Fichier As String, _
Entete As Boolean, _
LectureSeule As Boolean, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
'HDR > YES ou NO = entêtes de colonnes
'IMEX > 1 lecture seule, 2 lecture/écriture
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & IIf(Entete = True, "YES", "NO") & _
";IMEX=" & IIf(LectureSeule = True, 1, 2) & ";"""
End Sub
Sub LireModifierEnrg(CheminClasseurCible As String, _
NomFeuille As String, _
Plage As String, _
ChaineSQL As String, _
Entete As Boolean, _
TableauRetour, _
Optional Remplacer, _
Optional NomChamp)
'TableauRetour étant passé en reference, il contiendra
'les valeurs de la plage
Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim I As Integer, J As Integer
'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage
'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement pour effectuer la recherche
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Plage & "` " & ChaineSQL, ConnectCL
'sans entête, retourne la plage spécifiée
' .Open "SELECT * FROM `" & NomFeuille & "$" & _
' Plage & "` ", ConnectCL
If .RecordCount = 0 Then
MsgBox "Ancun enregistrement trouvé !"
Exit Sub
End If
.MoveFirst
'effectue la modif si les valeurs ont été passées en paramètre
'sinon retourne les enregistrements trouvés dans le tableau
If Not IsMissing(Remplacer) And Not IsMissing(NomChamp) Then
If MsgBox("Modifier les enregistrements ?", _
vbYesNo + vbQuestion) = vbNo Then Exit Sub
Do While Not .EOF
.Fields(NomChamp).Value = Remplacer
.Update
.MoveNext
Loop
Else
If Range(Plage).Cells.Count > 1 Then
ReDim TableauRetour( _
1 To .RecordCount, _
1 To .Fields.Count)
.MoveFirst
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
TableauRetour(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
Else
ReDim TableauRetour(1 To 1)
TableauRetour(1) = .Fields(0).Value
End If
End If
End With
ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub
Private Function Controle(CheminCible As String, _
Plage As String) As Boolean
Dim Factice As Range
'effectue un contrôle de validité de la plage
Controle = True
If Plage = "" Then
MsgBox "La plage passée en argument est vide !"
Controle = False
Exit Function
End If
If Dir(CheminCible) = "" Then
MsgBox "Le fichier '" & CheminCible & "' est introuvable !"
Controle = False
Exit Function
End If
If InStr(Plage, ";") <> 0 Then
MsgBox "La plage doit être contiguë !"
Controle = False
Exit Function
End If
On Error Resume Next
Set Factice = Range(Plage)
If Err.Number <> 0 Then
MsgBox "Erreur dans l'orthographe de la plage !" _
& vbCrLf & "Plage non valide > " & Plage
Controle = False
End If
Set Factice = Nothing
On Error GoTo 0
End Function
Sub LireModifier()
Dim Tbl
Dim Chemin As String
Dim NomFeuille As String
Dim Entete As Boolean
Dim ChaineSQL As String
Dim Rng As String
Dim Remplacer
'modifier le chemin du classeur cible
Chemin = "D:Classeur1.xls"
'feuille dans laquelle effectuer les recherches
NomFeuille = "Feuil1"
'plage de recherche dans le classeur cible
Rng = "A1:F50"
'si la plage de recherche n'a pas d'entête de colonne
'mettre à false, dans ce cas, retoure toute la plage
Entete = True
'indiquer le valeur de remplacement si tu veux modifier
Remplacer = ""
'valeur cherchée
'le signe % est un jocker qui remplace 1 ou plusieurs caractères
'le signe _ est un jocker qui remplace seulement un caractère
'les crochets [ae], avec les lettres à l'intérieur, s'utilisent
'comme le signe _ mais avec les lettres indiquées
'Cr[oia]ps retourne Crips, Crops, Craps
ChaineSQL = "WHERE Nom LIKE 'Cr[oia]ps' "
LireModifierEnrg Chemin, NomFeuille, Rng, ChaineSQL, Entete, Tbl
'adapte ici en fonction de ce que tu veux faire des valeurs retournées
'dans ce cas ci, elles sont inscritent dans "feuil2" du classeur actif
On Error Resume Next
If Remplacer = "" Then
With ThisWorkbook.Worksheets("Feuil2")
If Range(Rng).Cells.Count > 1 Then
.Range(.[A1], .Cells(UBound(Tbl, 1), _
UBound(Tbl, 2))).Value = Tbl
Else
.Range("A1").Value = Tbl(1)
End If
End With
Erase Tbl
End If
End Sub
Reviens si problèmes.
Hervé.
"Dardevil" a écrit dans le message news:Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel,
j'arrive
arechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans
un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds
lescellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
ca marche pas...
en fait comment ma question c comment rechercher une valeur dans un
fichier
fermé, puis en retirer son adresse de cellule?
merci
"Hervé" <hmsilve@wanadoo.fr> a écrit dans le message de
news:uWk9ivtrDHA.2332@TK2MSFTNGP09.phx.gbl...
Salut Daredevil,
L'exemple est avec ADO mais sans référence car en liaison tardive.
Tu peux supprimer la fonction "Controle" pour raccourcir le code si tu
est
sûr de la plage que tu passes (supprime aussi l'appel dans la proc
"LireModifierEnrg"). Pour tester, exécute la proc "LireModifier" en
ayant
pris soins d'adapter à tes valeurs (plage, chemin du classeur, non de la
feuille de recherche, nom de la feuille de récup). Le code parraît
compliqué, mais il est en fait très simple, donc pas de panique :
Private Sub ConnecterCLasseur(ConnectCL As Object, _
Fichier As String, _
Entete As Boolean, _
LectureSeule As Boolean, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
'HDR > YES ou NO = entêtes de colonnes
'IMEX > 1 lecture seule, 2 lecture/écriture
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & IIf(Entete = True, "YES", "NO") & _
";IMEX=" & IIf(LectureSeule = True, 1, 2) & ";"""
End Sub
Sub LireModifierEnrg(CheminClasseurCible As String, _
NomFeuille As String, _
Plage As String, _
ChaineSQL As String, _
Entete As Boolean, _
TableauRetour, _
Optional Remplacer, _
Optional NomChamp)
'TableauRetour étant passé en reference, il contiendra
'les valeurs de la plage
Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim I As Integer, J As Integer
'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage
'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement pour effectuer la recherche
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Plage & "` " & ChaineSQL, ConnectCL
'sans entête, retourne la plage spécifiée
' .Open "SELECT * FROM `" & NomFeuille & "$" & _
' Plage & "` ", ConnectCL
If .RecordCount = 0 Then
MsgBox "Ancun enregistrement trouvé !"
Exit Sub
End If
.MoveFirst
'effectue la modif si les valeurs ont été passées en paramètre
'sinon retourne les enregistrements trouvés dans le tableau
If Not IsMissing(Remplacer) And Not IsMissing(NomChamp) Then
If MsgBox("Modifier les enregistrements ?", _
vbYesNo + vbQuestion) = vbNo Then Exit Sub
Do While Not .EOF
.Fields(NomChamp).Value = Remplacer
.Update
.MoveNext
Loop
Else
If Range(Plage).Cells.Count > 1 Then
ReDim TableauRetour( _
1 To .RecordCount, _
1 To .Fields.Count)
.MoveFirst
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
TableauRetour(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
Else
ReDim TableauRetour(1 To 1)
TableauRetour(1) = .Fields(0).Value
End If
End If
End With
ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub
Private Function Controle(CheminCible As String, _
Plage As String) As Boolean
Dim Factice As Range
'effectue un contrôle de validité de la plage
Controle = True
If Plage = "" Then
MsgBox "La plage passée en argument est vide !"
Controle = False
Exit Function
End If
If Dir(CheminCible) = "" Then
MsgBox "Le fichier '" & CheminCible & "' est introuvable !"
Controle = False
Exit Function
End If
If InStr(Plage, ";") <> 0 Then
MsgBox "La plage doit être contiguë !"
Controle = False
Exit Function
End If
On Error Resume Next
Set Factice = Range(Plage)
If Err.Number <> 0 Then
MsgBox "Erreur dans l'orthographe de la plage !" _
& vbCrLf & "Plage non valide > " & Plage
Controle = False
End If
Set Factice = Nothing
On Error GoTo 0
End Function
Sub LireModifier()
Dim Tbl
Dim Chemin As String
Dim NomFeuille As String
Dim Entete As Boolean
Dim ChaineSQL As String
Dim Rng As String
Dim Remplacer
'modifier le chemin du classeur cible
Chemin = "D:Classeur1.xls"
'feuille dans laquelle effectuer les recherches
NomFeuille = "Feuil1"
'plage de recherche dans le classeur cible
Rng = "A1:F50"
'si la plage de recherche n'a pas d'entête de colonne
'mettre à false, dans ce cas, retoure toute la plage
Entete = True
'indiquer le valeur de remplacement si tu veux modifier
Remplacer = ""
'valeur cherchée
'le signe % est un jocker qui remplace 1 ou plusieurs caractères
'le signe _ est un jocker qui remplace seulement un caractère
'les crochets [ae], avec les lettres à l'intérieur, s'utilisent
'comme le signe _ mais avec les lettres indiquées
'Cr[oia]ps retourne Crips, Crops, Craps
ChaineSQL = "WHERE Nom LIKE 'Cr[oia]ps' "
LireModifierEnrg Chemin, NomFeuille, Rng, ChaineSQL, Entete, Tbl
'adapte ici en fonction de ce que tu veux faire des valeurs retournées
'dans ce cas ci, elles sont inscritent dans "feuil2" du classeur actif
On Error Resume Next
If Remplacer = "" Then
With ThisWorkbook.Worksheets("Feuil2")
If Range(Rng).Cells.Count > 1 Then
.Range(.[A1], .Cells(UBound(Tbl, 1), _
UBound(Tbl, 2))).Value = Tbl
Else
.Range("A1").Value = Tbl(1)
End If
End With
Erase Tbl
End If
End Sub
Reviens si problèmes.
Hervé.
"Dardevil" <ggaudfroy@free.fr> a écrit dans le message news:
eEiGS4orDHA.540@tk2msftngp13.phx.gbl...
Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel,
j'arrive
a
rechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans
un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds
les
cellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil
ca marche pas...
en fait comment ma question c comment rechercher une valeur dans un
fichier
fermé, puis en retirer son adresse de cellule?
merci
"Hervé" a écrit dans le message de
news:Salut Daredevil,
L'exemple est avec ADO mais sans référence car en liaison tardive.
Tu peux supprimer la fonction "Controle" pour raccourcir le code si tu
est
sûr de la plage que tu passes (supprime aussi l'appel dans la proc
"LireModifierEnrg"). Pour tester, exécute la proc "LireModifier" en
ayant
pris soins d'adapter à tes valeurs (plage, chemin du classeur, non de la
feuille de recherche, nom de la feuille de récup). Le code parraît
compliqué, mais il est en fait très simple, donc pas de panique :
Private Sub ConnecterCLasseur(ConnectCL As Object, _
Fichier As String, _
Entete As Boolean, _
LectureSeule As Boolean, _
Optional Rs)
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If
'HDR > YES ou NO = entêtes de colonnes
'IMEX > 1 lecture seule, 2 lecture/écriture
ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & IIf(Entete = True, "YES", "NO") & _
";IMEX=" & IIf(LectureSeule = True, 1, 2) & ";"""
End Sub
Sub LireModifierEnrg(CheminClasseurCible As String, _
NomFeuille As String, _
Plage As String, _
ChaineSQL As String, _
Entete As Boolean, _
TableauRetour, _
Optional Remplacer, _
Optional NomChamp)
'TableauRetour étant passé en reference, il contiendra
'les valeurs de la plage
Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim I As Integer, J As Integer
'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage
'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement pour effectuer la recherche
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Plage & "` " & ChaineSQL, ConnectCL
'sans entête, retourne la plage spécifiée
' .Open "SELECT * FROM `" & NomFeuille & "$" & _
' Plage & "` ", ConnectCL
If .RecordCount = 0 Then
MsgBox "Ancun enregistrement trouvé !"
Exit Sub
End If
.MoveFirst
'effectue la modif si les valeurs ont été passées en paramètre
'sinon retourne les enregistrements trouvés dans le tableau
If Not IsMissing(Remplacer) And Not IsMissing(NomChamp) Then
If MsgBox("Modifier les enregistrements ?", _
vbYesNo + vbQuestion) = vbNo Then Exit Sub
Do While Not .EOF
.Fields(NomChamp).Value = Remplacer
.Update
.MoveNext
Loop
Else
If Range(Plage).Cells.Count > 1 Then
ReDim TableauRetour( _
1 To .RecordCount, _
1 To .Fields.Count)
.MoveFirst
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
TableauRetour(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
Else
ReDim TableauRetour(1 To 1)
TableauRetour(1) = .Fields(0).Value
End If
End If
End With
ConnectCL.Close
Set Rs = Nothing
Set ConnectCL = Nothing
End Sub
Private Function Controle(CheminCible As String, _
Plage As String) As Boolean
Dim Factice As Range
'effectue un contrôle de validité de la plage
Controle = True
If Plage = "" Then
MsgBox "La plage passée en argument est vide !"
Controle = False
Exit Function
End If
If Dir(CheminCible) = "" Then
MsgBox "Le fichier '" & CheminCible & "' est introuvable !"
Controle = False
Exit Function
End If
If InStr(Plage, ";") <> 0 Then
MsgBox "La plage doit être contiguë !"
Controle = False
Exit Function
End If
On Error Resume Next
Set Factice = Range(Plage)
If Err.Number <> 0 Then
MsgBox "Erreur dans l'orthographe de la plage !" _
& vbCrLf & "Plage non valide > " & Plage
Controle = False
End If
Set Factice = Nothing
On Error GoTo 0
End Function
Sub LireModifier()
Dim Tbl
Dim Chemin As String
Dim NomFeuille As String
Dim Entete As Boolean
Dim ChaineSQL As String
Dim Rng As String
Dim Remplacer
'modifier le chemin du classeur cible
Chemin = "D:Classeur1.xls"
'feuille dans laquelle effectuer les recherches
NomFeuille = "Feuil1"
'plage de recherche dans le classeur cible
Rng = "A1:F50"
'si la plage de recherche n'a pas d'entête de colonne
'mettre à false, dans ce cas, retoure toute la plage
Entete = True
'indiquer le valeur de remplacement si tu veux modifier
Remplacer = ""
'valeur cherchée
'le signe % est un jocker qui remplace 1 ou plusieurs caractères
'le signe _ est un jocker qui remplace seulement un caractère
'les crochets [ae], avec les lettres à l'intérieur, s'utilisent
'comme le signe _ mais avec les lettres indiquées
'Cr[oia]ps retourne Crips, Crops, Craps
ChaineSQL = "WHERE Nom LIKE 'Cr[oia]ps' "
LireModifierEnrg Chemin, NomFeuille, Rng, ChaineSQL, Entete, Tbl
'adapte ici en fonction de ce que tu veux faire des valeurs retournées
'dans ce cas ci, elles sont inscritent dans "feuil2" du classeur actif
On Error Resume Next
If Remplacer = "" Then
With ThisWorkbook.Worksheets("Feuil2")
If Range(Rng).Cells.Count > 1 Then
.Range(.[A1], .Cells(UBound(Tbl, 1), _
UBound(Tbl, 2))).Value = Tbl
Else
.Range("A1").Value = Tbl(1)
End If
End With
Erase Tbl
End If
End Sub
Reviens si problèmes.
Hervé.
"Dardevil" a écrit dans le message news:Bonjour a tous
Voila, a l'heure actuelle, par la fonction recherche de Excel,
j'arrive
arechercher une valeur précise grave a un critere de recherche.
En faite, je recherche la valeur qu'avait un nom le mois d'avant dans
un
ensemble d'autres noms, mais qui ne sont jamais a la meme place.
Ca marche.!
=recherche(A1; nom du classeur...B1:B50; nom du classeur C1:C50)
comment faire pour simplidier ca en VBA, je ne veut pas de formule ds
lescellules et je voudrait passer par VBA.
De plus, je voudrait, lorsque j'ai localiser l'adresse de la ligne de
critere recherché prendre d'autre valeur ds les colonnes a coté.
C'est possible?
Merci
--
Dardevil