Tester si une cellule est vide
Bonjour,
J'ai un probleme que j'arrive pas à résoudre. Je veux écrire un bout de code vba qui va me permettre de recherché un mot, s'il trouve le mot, il mémorise l'adresse. Ainsi il va parcourir la case à laquelle il a trouvé le mot. Si la case est vide, il me la copie dans dans une autre feuille, jusqu'à ce que les test est faux.
J'arrive à faire rechercher le mot, mémoriser son adresse dans une variable.
Mais j'arrive pas à faire le test qui me permettra de faire la copie des cellule vides
Dim Trouve As Range
Dim a As String,
Dim c As Range
Dim vide As Boolean
'Recherche une Fonction de Protection et copier les donnees
MotRecherche = InputBox("Saisir le mot recherche")
Set Trouve = Cells.Find(what:=MotRecherche, LookAt:=xlWhole)
If Not Trouve Is Nothing Then
a = Trouve.Address(0, 0) 'mémorise l'adresse
For Each c In Worksheets("Feuil1").Range(a, "D").Cells
If c = "" Then
vide = True
Exit For
End If
Vous remerciant pour votre aide.
Bonjour,
Quelle signification a pour toi ceci ?
a = Trouve.Address(0, 0) 'mémorise l'adresse
For Each c In Worksheets("Feuil1").Range("A1", "D").Cellscar ça a en gros cette signification :
Range("A1", "D").CellsPour constater que ça ne peut pas fonctionner, testes ceci :
Sub Test2()
MsgBox Worksheets("Feuil1").Range("A1", "D").Cells.Address(0, 0)
End SubMaintenant, il te faut éclaircir ta demande :
Ainsi il va parcourir la case à laquelle il a trouvé le mot. Si la case est vide, il me la copie dans dans une autre feuille, jusqu'à ce que les test est faux.
Merci pour ta réponse
En gros cette partie me permet de parcourir à partir de l'adresse du mot trouvé jusqu'à la case non vide. En tout cas c'est ce que je veux faire :
a = Trouve.Address(0, 0) 'mémorise l'adresse
For Each c In Worksheets("Feuil1").Range(a, "D").Cells
Je te donne un exemple :
j'ai dans ma feuille 1,
15 cases D1 à D15
D1 = toto
D2 : D14 vide
D15 = toto1
Mon code doit etre capable en reentrant le mot toto, il me copie D1 à D15 dans une autre feuile 2
bonjour
salut Theze
à quoi sert le fichier : stocks, achats, machines, RH, températures, fabrications, élèves.. ?
Bonjour,
Une piste, le résultat en A1:Ax sur la feuille "Feuil2" :
Sub Test()
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Trouve As Range
Dim Mot As String
Dim I As Long
Mot = InputBox("Saisir le mot recherché !")
If Mot = "" Then Exit Sub
Set Fe1 = Worksheets("Feuil1")
Set Fe2 = Worksheets("Feuil2")
Set Trouve = Fe1.Cells.Find(Mot, , xlValues, xlWhole)
If Trouve Is Nothing Then Exit Sub
For I = Trouve.Row + 1 To Rows.Count
If Fe1.Cells(I, Trouve.Column).Value <> "" Then
With Fe1
Fe2.Range(Fe2.Cells(1, 1), _
Fe2.Cells(.Range(Trouve, _
.Cells(I, Trouve.Column)).Cells.Count, 1)).Value = _
.Range(Trouve, .Cells(I, Trouve.Column)).Value
End With
Exit For
End If
Next I
End SubBonjour jmd,
Tu veux dire quoi par :
à quoi sert le fichier : stocks, achats, machines, RH, températures, fabrications, élèves.. ?
Bonjour,
Une autre façon sans boucle (j'avais oublié End(xlDown) :
Sub Test()
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Trouve As Range
Dim Cel As Range
Dim Mot As String
Dim I As Long
Mot = InputBox("Saisir le mot recherché !")
If Mot = "" Then Exit Sub
Set Fe1 = Worksheets("Feuil1")
Set Fe2 = Worksheets("Feuil2")
Set Trouve = Fe1.Cells.Find(Mot, , xlValues, xlWhole)
If Trouve Is Nothing Then Exit Sub
Set Cel = Trouve.End(xlDown)
If Cel.Row = Rows.Count Then MsgBox "Aucune valeur trouvée sous " & Mot & " !": Exit Sub
Fe2.Range(Fe2.Cells(1, 1), Fe2.Cells(Cel.Row - Trouve.Row + 1, 1)).Value = Fe1.Range(Trouve, Cel).Value
End SubBonjour,
Theze,
Je m'en vais tester tes deux pistes. Je reviendrai vers toi.
Encore une fois merci.
Bonne journée à toi
J'ai testé tes deux pistes et ca marche saufe que j'avais mal donné mon exemple.
Au lieu de copier D1 à D15, c'est D1 à L15.
En prenant en compte la colonne L mais attention, si la dernière cellule remplie en colonne L est située au dessus de celle contenant le mot cherché, tu auras le message "Aucune valeur trouvée..." ou alors, il faut commencer la recherche à partir de L1 :
Sub Test()
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Trouve As Range
Dim Cel As Range
Dim Mot As String
Dim I As Long
Mot = InputBox("Saisir le mot recherché !")
If Mot = "" Then Exit Sub
Set Fe1 = Worksheets("Feuil1")
Set Fe2 = Worksheets("Feuil2")
Set Trouve = Fe1.Columns(4).Find(Mot, , xlValues, xlWhole)
If Trouve Is Nothing Then Exit Sub
Set Cel = Trouve.Offset(, 8).End(xlDown)
If Cel.Row = Rows.Count Then MsgBox "Aucune valeur trouvée en colonne L sous " & Mot & " !": Exit Sub
Fe2.Range(Fe2.Cells(1, 1), Fe2.Cells(Cel.Row - Trouve.Row + 1, Cel.Column - Trouve.Column + 1)).Value = Fe1.Range(Trouve, Cel).Value
End SubJe connais pas du tout la function offset. Par contre, le programme n'a pas l'air de fonctionner.
Je te joins mon fichier pour que tu regarde de quoi il a l'air si tu veux bien regarder ^^. Ce probleme j'arrive pas du tout à le résoudre. Mes connaissances tres limiter en vba me bloquent.
En te remerciant,
Si j'explique bien ce que je veux faire :
le mot cherché se trouve toujours dans une cellule fusionnée. Le macro doit etre capable de le trouver et de copier tout ce qui se trouve à l'intérieur jusqu'à la prochaine cellule fusionnée de la meme colonne que le mot cherché.
Tu dis :
J'ai testé tes deux pistes et ca marche saufe que j'avais mal donné mon exemple.
Au lieu de copier D1 à D15, c'est D1 à L15. ^^
mais dans ton classeur il n'y a rien en colonne D et encore moins en colonne L ???
Bon, je suppose que la valeur cherchée se trouve en colonne A dans les cellules fusionnées donc, voici une autre piste :
Sub Test()
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Plage As Range
Dim Zone As Range
Dim Cel As Range
Dim Mot As String
Mot = InputBox("Saisir le mot recherché !")
Set Fe1 = Worksheets("Feuil1")
Set Fe2 = Worksheets("Feuil2")
With Fe1: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
For Each Cel In Plage
If Cel.MergeCells Then
If Zone Is Nothing Then
If Cel.Value = Mot Then Set Zone = Cel.MergeArea
Else
Set Zone = Range(Zone, Cel.MergeArea): Exit For
End If
End If
Next Cel
Fe2.Range(Fe2.Cells(1, 1), Fe2.Cells(Zone.Rows.Count, Zone.Columns.Count)).Value = Zone.Value
End SubLa méthode Find() ne fonctionne pas sur des cellules fusionnées d'où la nécessité de boucler sur la plage à la recherche du mot !
Bonjour,
Ah oui t'as raison mais après ça reste le meme principe ^^.
Par contre j'ai une erreur d'execution 91 au niveau de cette ligne :
Fe2.Range(Fe2.Cells(1, 1), Fe2.Cells(Zone.Rows.Count, Zone.Columns.Count)).Value = Zone.Value
Bonjour,
prise en compte de l'erreur 91 (la valeur recherchée n'a pas été trouvée en colonne A). J'ai commenté le code afin que tu en comprenne le fonctionnement :
Sub Test()
Dim Fe1 As Worksheet
Dim Fe2 As Worksheet
Dim Plage As Range
Dim Zone As Range
Dim Cel As Range
Dim Mot As String
Mot = InputBox("Saisir le mot recherché !")
'utilise des variables objet
Set Fe1 = Worksheets("Feuil1")
Set Fe2 = Worksheets("Feuil2")
'défini la plage sur la colonne A de la feuille "Feuil1"
With Fe1: Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
'parcours la plage...
For Each Cel In Plage
'...en recherchant tout d'abords les cellules fusionnées
If Cel.MergeCells Then
'si la variable n'a pas encore été initialisé...
If Zone Is Nothing Then
'cherche à savoir si la cellule en cours contient le mot recherché,
'si c'est le cas, défini la zone de départ
If Cel.Value = Mot Then Set Zone = Cel.MergeArea
'sinon, si la variable a été initialisée, les cellules fusionnées rencontrées ensuite
'définissent la fin du Range dont on veut récupérer les valeurs et donc, fin de boucle
Else
Set Zone = Range(Zone, Cel.MergeArea): Exit For
End If
End If
Next Cel
'si la valeur n'a pas été trouvée, message et fin !
If Zone Is Nothing Then MsgBox "Valeur pas trouvée !": Exit Sub
'inscrit les valeurs dans la feuille "Feuil2"
Fe2.Range(Fe2.Cells(1, 1), Fe2.Cells(Zone.Rows.Count, Zone.Columns.Count)).Value = Zone.Value
End SubBonjour,
Merci theze pour ton aide.
D'une première vue, j'avais pas trop compris le code mais avec l'erreur j'ai pu constater qu'il n'était pas trop adapter à mon fichier d'origine. Il fallait redéfinir la plage de recherche sur la colonne adaptée à mon classeur ^^. Et ca marche bien!!
En tout cas merci beacoup pour ton aide.
Bon week-end à toi..
Bon Week-end à toi aussi !