Bom dia Bruno.
Cara muito bom, fez parcialmente o que eu queria. Eu só preciso de uma adaptação que eu não estou conseguindo fazer.
Por exemplo, alguns títulos podem já terem sido pagos, portanto estes não deve ser alterados. Eu fiz a lógica, juntando com o código que você fez, que todos os títulos com vencimento maior que Hoje (função Now) vão ser alterados. Porém eu não estou conseguindo fazer com que a linha alterada seja a que está sendo verificada no If.
Não sei se deu para entender.
Sub AlterarVencimento()
Dim Ulinha As Double
Dim Subts As String
Dim d As String
Dim m As String
Dim y As String
Dim Area As Range
Dim Cel As Range
UltLinhaCondicao = Plan4.Cells(Rows.Count, "A").End(xlUp).Row
Hoje = Format(Now, "MM/DD/YYYY")
For i = 2 To UltLinhaCondicao
If CDate(Plan4.Cells(i, "A")) > Hoje Then
'Última linha preenchida
Ulinha = Plan4.Range("A1048575").End(xlUp).Row
'Seleciona a area de busca. Lembre-se: Cells(2,1)=A2
Set Area = Plan4.Range(Cells(2, 6), Cells(Ulinha, 6))
'Para cada célula dentro da área.
For Each Cel In Area
'Se o valor da célula (nome) for igual ao selecionado
If Trim(UCase(Cel) = Trim(UCase(fmCadastroAluno.tbNome))) Then
Subts = CStr(Trim(Format(Cel.Offset(0, -5), "dd/mm/yyyy")))
'O dia vai ser o valor do textbox
d = CStr(fmCadastroAluno.cbVencimento)
'mês
m = CStr(Left(Right(Subts, 7), 2))
'ano
y = CStr(Right(Subts, 4))
'Por algum motivo entrando do mês/dia/ano,
'sai na célula dia/mês/ano.
Cel.Offset(0, -5) = m & "/" & d & "/" & y
End If
Next Cel
End If
Next
End Sub
Boa noite rafaelp,
Veja se ajuda.
O código está dentro do botão 'Alterar Vencimento'.
att,
Postado : 08/09/2016 6:05 am