Macro buscar
Hola experto como hago una macro que me busque varios valores en una columna, y al frente de cada columna donde encuentre el valor ponga cierto mensaje?
tengo la siguiente macro, pero solo lo hace en un valor
Sub Buscar()
Dim rng As Range, msg As String
Dim fecha As String
With Columns("A:A")
Set rng = .Find( _
What:=InputBox("Introduce el Número de Tráfico: "), _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
End With
If Not rng Is Nothing Then
Range(rng.Address).Offset(0, 4) = InputBox("Introduce Nueva Fecha")
Range(rng.Address).Offset(0, 5) = Range(rng.Address).Offset(0, 4)
End If
End Sub
tengo la siguiente macro, pero solo lo hace en un valor
Sub Buscar()
Dim rng As Range, msg As String
Dim fecha As String
With Columns("A:A")
Set rng = .Find( _
What:=InputBox("Introduce el Número de Tráfico: "), _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
End With
If Not rng Is Nothing Then
Range(rng.Address).Offset(0, 4) = InputBox("Introduce Nueva Fecha")
Range(rng.Address).Offset(0, 5) = Range(rng.Address).Offset(0, 4)
End If
End Sub
Respuesta de calvuch
1
Prueba esto.
Sub Buscar()
Dim t As String
Dim r As Range
t = InputBox("Introduce el Número de Tráfico: ")
If Len(t) = 0 Then Exit Sub
If Application.WorksheetFunction.CountIf(Range("A:A"), t) = 0 Then Exit Sub
For Each r In Range("A1" & ":" & "A" & Application.WorksheetFunction.CountA(Range("A:A")))
If r = t Then
r.Offset(0, 4) = InputBox("Introduce Nueva Fecha")
r.Offset(0, 5) = r.Offset(0, 4)
End If
DoEvents
Next
Set r = Nothing
End Sub
Sub Buscar()
Dim t As String
Dim r As Range
t = InputBox("Introduce el Número de Tráfico: ")
If Len(t) = 0 Then Exit Sub
If Application.WorksheetFunction.CountIf(Range("A:A"), t) = 0 Then Exit Sub
For Each r In Range("A1" & ":" & "A" & Application.WorksheetFunction.CountA(Range("A:A")))
If r = t Then
r.Offset(0, 4) = InputBox("Introduce Nueva Fecha")
r.Offset(0, 5) = r.Offset(0, 4)
End If
DoEvents
Next
Set r = Nothing
End Sub
