VBA - Comparaison cellule par rapport à une plage
Bonjour à toutes et à tous,
Je début en VBA et comme je me suis servi des tutos de ce site pour pondre mon premier code, j'aimerais vous le soumettre car forcément j'ai un plantage.
D'abord l'explication :
Cette macro effectue une action de contrôle de valeur de cellule par rapport à une plage donnée qui sert de référence.
Seulement voilà, j'ai une erreur "incompatibilité de type" qui survient lors d'affectation de valeur aux variables (du moins l'erreur renvoie à cette ligne).
Après moult péripéties et recherches, voici le code fini.
Sub controle()
'
' Cette macro effectue un contrôle des entités et catégories saisies
'
' Dû à une erreur amenée par les liaisons à un document externe, on vient rompre ces liaisons.
If Not IsEmpty(ActiveWorkbook.LinkSources(xlExcelLinks)) Then
For Each X In ActiveWorkbook.LinkSources(xlExcelLinks)
ActiveWorkbook.BreakLink Name:=X, Type:=xlExcelLinks
Next
End If
Sheets("Sheets1").Activate
Columns("E:E").Select
Selection.Replace What:="#N/A", Replacement:="Erreur", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Nettoyage de l'onglet "log_error"
Sheets("log_error").Activate
ActiveSheet.Range("$A$1:$A" & Range("A65536").End(xlUp).Row).Select
Selection.EntireRow.Delete
Sheets("log_error").Activate
ActiveSheet.Range("$A" & Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Sheets("log_error").Activate
ActiveSheet.Range("$A" & Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "Sheets1"
' On vient ici parcourir les plages de cellule et on vérifie la présence des valeurs dans l'onget de référence pour Sheets1
'Parcours la plage de référence pour la vérification des entités
verif_cell_ent_geo = Sheets("Ref").Range("$A$3:$A$" & Sheets("Ref").Range("A65536").End(xlUp).Row)
' Parcours de la plage saisie par le support
Dim val_cell_ent_geo As Range
For Each val_cell_ent_geo In Sheets("Sheets1").Range("$E$2:$E$" & Sheets("Sheets1").Range("E65536").End(xlUp).Row)
If val_cell_ent_geo.Value <> "" And IsError(Application.VLookup(val_cell_ent_geo.Value, verif_cell_ent_geo, 1, False)) = True Then
' On copie la ligne en défaut dans l'onglet log_error
Sheets("Sheets1").Activate
ActiveSheet.Range("$A" & val_cell_ent_geo.Row & ":$K" & val_cell_ent_geo.Row).Select
Selection.Copy
Sheets("log_error").Activate
ActiveSheet.Range("$A" & Sheets("log_error").Range("A65536").End(xlUp).Row + 1).Select
ActiveSheet.Paste
ActiveSheet.Range("$E" & Sheets("log_error").Range("E65536").End(xlUp).Row).Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
End SubBonne chance au suivant !
Bonjour
Je n'ai pas le fichier, donc, je ne peux contôler.
Cependant, tes instruction désignent un champ et Value me parait superflu
essaie
verif_cell_ent = Sheets("Ref").Range("A3:A37
verif_cell_cat = Sheets("Ref").Range("B3:B10")Cordialement
Bonjour Amadéus,
Merci pour ce premier conseil.
Je viens de tester et cela persiste.
Est-ce que j'utilise la bonne méthode pour ce que je veux faire ?
J'ai réalisé qu'en fait, il faut parcourir une plage pour vérifier les cellules de cette même plage correspondent à encore une autre sur un autre onglet (oui c'est dur je sais).
Je suis parti pour tester autre chose mais si tu as des idées je prends.
Merki !
Bonjour
Précédent message
.Je n'ai pas le fichier, donc, je ne peux contôler
A toi de voir...
Cordialement
Bonjour Amadéus,
Finalement j'ai complètement changé le code en me basant sur divers tutos et forums.
Voici ce que j'ai pondu :
Sub controle()
'
' Cette macro effectue un contrôle des valeurs saisies
'
' Nettoyage de l'onglet "log_error"
Sheets("log_error").Activate
ActiveSheet.Range("$A$1:$A" & Range("A65536").End(xlUp).Row).Select
Selection.EntireRow.Delete
ActiveSheet.Range("$A" & Sheets("log_error").Range("A65536").End(xlUp).Row).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
ActiveSheet.Range("$A" & Sheets("log_error").Range("A65536").End(xlUp).Row).Select
ActiveCell.FormulaR1C1 = "Sheets1"
' Dû à une erreur amenée par les liaisons à un document externe, on vient rompre ces liaisons.
If Not IsEmpty(ActiveWorkbook.LinkSources(xlExcelLinks)) Then
For Each X In ActiveWorkbook.LinkSources(xlExcelLinks)
ActiveWorkbook.BreakLink Name:=X, Type:=xlExcelLinks
Next
End If
' On vient ici parcourir les plages de cellule et on vérifie la présence des valeurs dans l'onget de référence pour Sheets1
' Parcours de la plage de référence pour la vérification des valeurs
verif_cell_ent_geo = Sheets("Ref").Range("$A$3:$A$" & Sheets("Ref").Range("A65536").End(xlUp).Row)
' Parcours de la plage saisie par le support
Dim val_cell_ent_geo As Range
For Each val_cell_ent_geo In Sheets("Sheets1").Range("$E$2:$E$" & Sheets("Sheets1").Range("E65536").End(xlUp).Row)
' Comparaison des valeurs récupérées
If val_cell_ent_geo.Value <> "" And IsError(Application.VLookup(val_cell_ent_geo.Value, verif_cell_ent_geo, 1, False)) = True Then
' On copie la ligne en défaut dans l'onglet log_error avec une surbrillance sur la cellule en erreur.
Sheets("Sheets1").Activate
ActiveSheet.Range("$A" & val_cell_ent_geo.Row & ":$K" & val_cell_ent_geo.Row).Select
Selection.Copy
Sheets("log_error").Activate
ActiveSheet.Range("$A" & Sheets("log_error").Range("A65536").End(xlUp).Row + 1).Select
ActiveSheet.Paste
ActiveSheet.Range("$E" & Sheets("log_error").Range("E65536").End(xlUp).Row).Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
MsgBox "fini"
End SubIl me reste encore à réussir à faire fonctionner cette macro qui plante lors d'erreurs dans les cellules dû à des impossibilités de récupération de valeurs situées sur des classeurs externes. Le plantage persiste malgré la rupture de lien en début de code.
Je cherche donc quelque chose pour tester ce genre de champ.
Je fouille le net et je viendrai mettre à jour ici la macro.
En attendant si l'un d'entre-vous a une idée lumineuse. : )
Petite progression, j'ai trouvé une fonction sur un autre forum
Dim Y As Range
For Each Y In Sheets("Sheets1").Range("$E$2:$E$" & Sheets("Sheets1").Range("E65536").End(xlUp).Row)
If Application.WorksheetFunction.IsNA(ActiveCell) Then
ActiveCell.Value = "Erreur"
End If
NextLe parcours des lignes se fait bien mais il ne fait pas la modif souhaitée.
Je pense donc que le "If" est foireux au niveau de la fonction utilisée. Ou alors c'est le paramètre (ActiveCell) qui n'est pas bon.
Pour info, j'utilise Excel 2007 avec un format .xlsm.
Merci pour votre aide.
J'ai trouvé !
Sheets("Sheets1").Activate
Columns("E:E").Select
Selection.Replace What:="#N/A", Replacement:="Erreur", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=FalseBon là j'ai triché, j'ai fait un enregistrement de macros !
Je modifie mon premier post avec le code propre en espérant que ça serve à quelqu'un.
Bonne journée !