Estou postando apenas os códigos pois o tamanho do arquivo ultrapassou o limite:
Apague todo código que houver no Objeto Planilha4(fev) e insira esses dois.
Faça o teste e veja se é isso mesmo.
Private Sub Worksheet_Activate()
Dim ul As Long, aluno As String
On Error Resume Next
ul = Planilha4.Range("A" & Rows.Count).End(xlUp).Row
ul1 = Planilha3.Range("A" & Rows.Count).End(xlUp).Row
Planilha4.Range("A5:A" & ul).ClearComments
For i = 5 To ul
If Planilha4.Range("A" & i).Value <> "" Then
aluno = Application.WorksheetFunction.VLookup(Planilha4.Range("A" & i).Value, Planilha3.Range("A5:F" & ul1), 6, 0)
Planilha4.Range("A" & i).AddComment
Planilha4.Range("A" & i).Comment.Text Text:=aluno
End If
If Planilha4.Range("AH" & i).Value <> "" Then
aluno2 = Application.WorksheetFunction.VLookup(Planilha4.Range("AH" & i).Value, Planilha3.Range("A5:F" & ul1), 6, 0)
Planilha4.Range("AH" & i).AddComment
Planilha4.Range("AH" & i).Comment.Text Text:=aluno2
End If
Next i
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ul As Long, aluno As String
On Error Resume Next
ul = Planilha3.Range("A" & Rows.Count).End(xlUp).Row
aluno = Application.WorksheetFunction.VLookup(Target.Value, Planilha3.Range("A5:F" & ul), 6, 0)
If Target.Cells.Count > 1 Then
Exit Sub
End If
If Target.Column = 1 Or Target.Column = 34 Then
If IsEmpty(Target) Then
Target.Comment.Delete
Else
Target.AddComment
Target.Comment.Text Text:=aluno
End If
End If
End Sub
___________________________________________________________________________________________
Se a resposta atendeu sua dúvida, por favor, clique no Gostei e marque o Tópico como [Resolvido].
Att.
André Arruda
Postado : 19/04/2018 3:54 pm