Si la valeur d'une cellule est effacée, effacer d'autre cellules
Bonjour!
Petit problème, assez simple mais encore trop complexe pour moi. J'aurais besoin d'une macro événementielle pour Excel 2007.
Elle doit faire ceci:
À partir de la ligne 21, lorsque la valeur de la colonne G est effacée, je voudrais que les cellules K, M, N, O, P, Q et R de la même ligne soient aussi effacées.
Il y a déjà une macro événementielle sur mon fichier. Est-ce qu'il y a un problème à mettre plusieurs macros événementielles? Est-ce qu'il faut les combiner ou faire quelque chose de spécial pour que ça fonctionne? Excusez mes questions, je suis encore débutant.
Merci! :)
Bonjour,
Voici un essai (avec un petit doute sur range("K, M:R") ) :
private sub worksheet_change(byval target as range)
dim r as range
set r = intersect(target, columns(7))
if not r is nothing then
for each cell in r.cells
if cell.row > 20 then
if cell.value = "" then range("K:K, M:R").rows(cell.row).clearcontents
end if
next cell
end if
end subIl n'y a qu'une seule macro par évènement. Pour l'évènement change, on peut décider que le comportement change en fonction de la zone ciblée par la modification.
Par exemple :
private sub worksheet_change(byval target as range)
if target.column = 1 then
msgbox "modif en colonne A"
elseif target.column = 2 then
msgbox "modif en colonne B"
else
msgbox "modif ailleurs qu'en A ou B"
target.interior.color = 255
end if
end subCdlt,
Ça fonctionne très bien! Merci! Mais j'ai du effacer l'autre macro pour installer celle-ci. Je ne sais toujours pas comment on fait pour mettre deux macros en même temps. Il y a encore quelque chose que je ne comprend pas.
Voici mon autre macro événementielle, si ça peut être utile.
Option Explicit
Private Sub worksheet_change(ByVal target As Range)
If target.Column <> 7 Or target.Count > 1 Then Exit Sub
Dim chemin$, fichier$, feuille$, adr$, fich$, form$, i As Variant
chemin = "P:\TQCFGplay\registres_de_production\" 'à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
feuille = "Feuil1" 'nom des feuilles sources, à adapter
If fichier = "" Then MsgBox "Aucun fichier .xls* trouvé...": Exit Sub
adr = target.Address(, , xlR1C1, True)
Do While fichier <> ""
fich = Replace(fichier, "'", "''") 's'il y a une apostrophe dans le nom
form = "'" & chemin & "[" & fich & "]" & feuille & "'!"
i = ExecuteExcel4Macro("MATCH(" & adr & "," & form & "C9,0)") 'formule de liaison
If IsNumeric(i) Then
target(1, 12) = ExecuteExcel4Macro("INDEX(" & form & "C10," & i & ")") 'durée
target(1, 5) = ExecuteExcel4Macro("INDEX(" & form & "C13," & i & ")") 'titre
target(1, 7) = ExecuteExcel4Macro("INDEX(" & form & "C16," & i & ")") 'logo
target(1, 8) = ExecuteExcel4Macro("INDEX(" & form & "C17," & i & ")") 'verset
target(1, 9) = ExecuteExcel4Macro("INDEX(" & form & "C18," & i & ")") 'fonctions
Exit Do 'on sort à la 1ère occurrence
End If
fichier = Dir 'fichier suivant
Loop
'If IsError(i) Then Union(Target(1, 0), Target(1, 2)) = "" 'RAZ
Range("H2").Copy target.Offset(0, -1)
End SubJ'ai l'impression que je ne peux pas éditer mon dernier message. Désolé pour le double post.
Je commence à comprendre le problème. Si je comprends bien, les deux macros ne pourraient pas fonctionner puisqu'elles visent la même colonne. Je vais étudier la question et essayer de comprendre un peu mieux le fonctionnement des macros et je reviens demain.
Bonjour le fil
On peut tout à fait mettre plusieurs codes, voici ce que je ferais
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Chemin$, Fichier$, Feuille$, Adr$, Fich$, Form$, i As Variant
'
If Target.Column <> 7 Or Target.Count > 1 Then Exit Sub
' Si modification dans colonne 7 et ligne >= 21
If Target.Value = "" And Target.Row >= 21 Then
Application.EnableEvents = False
' Range("K:K, M:R").Rows(Target.Row).ClearContents = Ne fonctionne pas correctemnt !?
Range("K" & Target.Row & ",M" & Target.Row & ":R" & Target.Row).ClearContents
Application.EnableEvents = True
Exit Sub ' On sort de la procédure
End If
'
Chemin = "P:\TQCFGplay\registres_de_production\" 'à adapter
Fichier = Dir(Chemin & "*.xls*") '1er fichier du dossier
Feuille = "Feuil1" 'nom des feuilles sources, à adapter
If Fichier = "" Then MsgBox "Aucun fichier .xls* trouvé...": Exit Sub
Adr = Target.Address(, , xlR1C1, True)
Do While Fichier <> ""
Fich = Replace(Fichier, "'", "''") 's'il y a une apostrophe dans le nom
Form = "'" & Chemin & "[" & Fich & "]" & Feuille & "'!"
i = ExecuteExcel4Macro("MATCH(" & Adr & "," & Form & "C9,0)") 'formule de liaison
If IsNumeric(i) Then
Target(1, 12) = ExecuteExcel4Macro("INDEX(" & Form & "C10," & i & ")") 'durée
Target(1, 5) = ExecuteExcel4Macro("INDEX(" & Form & "C13," & i & ")") 'titre
Target(1, 7) = ExecuteExcel4Macro("INDEX(" & Form & "C16," & i & ")") 'logo
Target(1, 8) = ExecuteExcel4Macro("INDEX(" & Form & "C17," & i & ")") 'verset
Target(1, 9) = ExecuteExcel4Macro("INDEX(" & Form & "C18," & i & ")") 'fonctions
Exit Do 'on sort à la 1ère occurrence
End If
Fichier = Dir 'fichier suivant
Loop
Application.EnableEvents = False
Range("H2").Copy Target.Offset(0, -1)
Application.EnableEvents = True
End Sub@+
Merci BrunoM45. Ça fonctionne! En plus, j'ai appris des choses! :D