=ici
Si vous avez des doutes c'est que vous n'avez rien testé...Peut être comme dit Job75, c'est automatique et rien n'est à faire de plus
Private Sub Worksheet_Calculate()
Dim n&, i&, r As Range, x$, c As Range
n = 100 'nombre de cellules cibles, à adapter
Application.EnableEvents = False
On Error Resume Next
For i = 1 To n
Set r = Nothing
Set r = Evaluate("Cible" & i)
If Not r Is Nothing Then
1 x = "µµµ": Set c = Nothing
x = Evaluate(ThisWorkbook.Names("TexteCible" & i).RefersTo)
Set c = r.Parent.Cells.Find(x, , xlValues, xlWhole)
If c Is Nothing Then ThisWorkbook.Names.Add "TexteCible" & i, r.Value
c.Name = "Cible" & i
Set r = Evaluate("Cible" & i)
If Not Application.IsText(r) Then
Application.Goto r
r = "TexteCible" & i
MsgBox "'Cible" & i & "' doit être un texte..."
GoTo 1
End If
End If
Next
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Calculate()
Dim n&, i&, r As Range, x$, P As Range, ncol%, tablo, lig&, col%
n = 100 'nombre de cellules cibles, à adapter
Application.EnableEvents = False
On Error Resume Next
For i = 1 To n
Set r = Nothing
Set r = Evaluate("Cible" & i)
If Not r Is Nothing Then
x = "µµµ"
x = CStr(Evaluate(ThisWorkbook.Names("TexteCible" & i).RefersTo))
Set P = r.Parent.UsedRange
ncol = P.Columns.Count
tablo = P.Value2 'matrice, plus rapide, Value2 nécessaire si date
For lig = 1 To P.Rows.Count
For col = 1 To ncol
If CStr(tablo(lig, col)) = x Then P(lig, col).Name = "Cible" & i: GoTo 1
Next col, lig
2 ThisWorkbook.Names.Add "TexteCible" & i, r.Value2
If IsError(Evaluate(ThisWorkbook.Names("TexteCible" & i).RefersTo)) Then r = "TexteCible" & i & " ?": GoTo 2
End If
1 Next
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Calculate()
Dim n&, i&, r As Range, x$, P As Range, ncol%, tablo, lig&, col%
n = 100 'nombre de cellules cibles, à adapter
Application.EnableEvents = False
On Error Resume Next
For i = 1 To n
Set r = Nothing
Set r = Evaluate("Cible" & i)
If Not r Is Nothing Then
x = "µµµ"
x = CStr(Evaluate(ThisWorkbook.Names("TexteCible" & i).RefersTo))
If x <> CStr(r.Value2) Then
Set P = r.Parent.UsedRange
ncol = P.Columns.Count
tablo = P.Value2 'matrice, plus rapide, Value2 nécessaire si date
For lig = 1 To P.Rows.Count
For col = 1 To ncol
If CStr(tablo(lig, col)) = x Then P(lig, col).Name = "Cible" & i: GoTo 1
Next col, lig
2 ThisWorkbook.Names.Add "TexteCible" & i, r.Value2
If IsError(Evaluate(ThisWorkbook.Names("TexteCible" & i).RefersTo)) Then r = "TexteCible" & i & " ?": GoTo 2
End If
End If
1 Next
Application.EnableEvents = True
End Sub
Dans toutes mes solutions les cellules cibles peuvent être modifiées ou triées, c'est fait pour ça !Je vais regarder ce soir tes autres propos mais plus particulièrement ton avant dernière, car mes cellules Cibles peuvent êtres modifiées ou triées......
Private Sub Worksheet_Calculate()
Dim n&, i&, r As Range, c As Range
n = 100 'nombre de cellules cibles, à adapter
Application.EnableEvents = False
On Error Resume Next
For i = 1 To n
Set r = Nothing
Set r = Evaluate("Cible" & i)
If Not r Is Nothing Then
If r.Comment.Text <> "Cible" & i Then
Set c = r.Parent.Cells.Find("Cible" & i, , xlComments, xlWhole)
If Not c Is Nothing Then c.Name = "Cible" & i: GoTo 1
'---création du commentaire---
r.ClearComments
r.AddComment "Cible" & i
r.Comment.Shape.TextFrame.AutoSize = True 'dimensionnement
r.Comment.Shape.TextFrame.Characters.Font.Bold = True 'gras (facultatif)
End If
End If
1 Next
Set c = Cells.Find("", , xlFormulas, xlPart) 'RAZ de la boîte de dialogue Rechercher
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = 0 Then Calculate
End Sub