Macro para halar datos según la fecha actual (va dirigida a D.A.)
La idea ahora es lograr hacer lo que me ayudaste en la anterior pero ahora es más complejo ya que debo medir más indicadores en la misma hoja y en el mismo periodo. Para lo cual remito correo electrónico con el modelo...
Por favor ten en cuenta:
Nota 1: En el mismo evento Change de la hoja tengo otra rutina. ¿Cómo deben quedar para que ambas se ejecuten?
Private Sub Worksheet_Change(ByVal Target As Range)
‘Gustavo
If Not Intersect(Target, Range("rSeleccion")) Is Nothing Then
Application.EnableEvents = False
Range("A1").Select
ActiveSheet.Protect
Application.EnableEvents = True
End If
End Sub
Nota2: En la solución anterior en los módulos 1 y 2 hay una macros, ¿las debo usar?
1 Respuesta
El archivo que me enviaste no tiene las macros.
Además en esta macro tiene esta línea
If Not Intersect(Target, Range("rSeleccion")) Is Nothing Then
Dice que en la hoja hay un nombre definido como "rSeleccion", y en la hoja que me enviaste no está ese nombre, podrías enviar el archivo que contiene la información y me explicas con ejemplos y paso a paso lo que quieres que haga.
Hola Dante: Remití archivo completo en construcción con las explicaciones paso a paso.
Esta es la macro para el evento change
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("rSeleccion")) Is Nothing Then
Application.EnableEvents = False
Range("A1").Select
ActiveSheet.Protect
Application.EnableEvents = True
End If
If Target.Address(False, False) = "QK2" Then
If Target.Count > 1 Then Exit Sub
'
Range("QM2:QX10").Font.Bold = False
Range("QM2:QX10").Interior.ColorIndex = xlNone
'
col = Columns("QL").Column
co2 = Columns("QB").Column
'
For j = 2 To 10
For i = 1 To 12
If Month([QK2]) = i Then
año = Year([QK2])
mes = Month([QK2])
Cells(j, col + i).Font.Bold = True
Cells(j, col + i).Interior.ColorIndex = 6
Else
mes = i
If Month([QK2]) < i Then
año = Year([QK2]) - 1
Else
año = Year([QK2])
End If
End If
fecha = DateSerial(año, mes, 1)
Set b = Columns("QA").Find(fecha, lookat:=xlWhole)
If Not b Is Nothing Then
Cells(j, col + i) = Cells(b.Row, co2)
Else
Cells(j, col + i) = 0
End If
Next
co2 = co2 + 1
Next
End If
End Sub
