MACRO comparar fecha dentro de rango y poner 1
Lo que deseo es que en la celda "A2", poner la semana y que la busque en la fila 3, luego de encontrarla que compare las fechas de la columna "B" con las 2 celdas inferiores a la semana ya encontrada " parametros" si está dentro de estos en la columna B al costado de la fecha que se ponga 1, si no es así que no se ponga nada y continue con la siguiente celda de la columna B.
1 Respuesta
Respuesta de James Bond
1
Primero corre una columna tus datos para que queden así, luego copia la macro abajo de esta imagen
Sub buscar_fechas()
Set fechas = Range("a4").CurrentRegion
Set parametros = Range("d3").CurrentRegion
With fechas
Set fechas = .Rows(3).Resize(.Rows.Count - 2)
.Columns(2).ClearContents
End With
With parametros
Set parametros = .Columns(2).Resize(.Rows.Count, .Columns.Count - 1)
semana = Range("a2")
On Error Resume Next
columna = WorksheetFunction.Match(semana, .Rows(1), 0)
If Err.Number > 0 Then End
On Error GoTo 0
Set fec = .Cells(2, columna).Resize(.Rows.Count - 1, 1)
With fec
For i = 1 To .Rows.Count
fech = .Cells(i, 1)
On Error Resume Next
fila = WorksheetFunction.Match(CDbl((fech)), fechas.Columns(1), 0)
If Err.Number > 0 Then GoTo salida
On Error GoTo 0
cuenta = WorksheetFunction.CountIf(fechas.Columns(1), fech)
If cuenta = 0 Then GoTo salida
fechas.Cells(fila, 2).Resize(cuenta, 1) = 1
salida:
Next i
End With
End With
End Sub
Gracias, por tu apoyo, pero esto solo funciona si la fecha es 30/08/2017 o 05/09/2017, y lo que deseo es que si está dentro de este rango aparezca 1. Ejemplo si en fecha hay, 01/09/2017 o 03/09/2017 aparezcan también. Gracias por tu apoyo.
Prueba entonces con esta macro
Sub agregar_uno()
Set datos = Range("a4").CurrentRegion
Set datos2 = Range("d3").CurrentRegion
With datos
Set datos = .Rows(3).Resize(.Rows.Count - 2, .Columns.Count)
.Columns(2).ClearContents
With datos2
Set datos2 = .Columns(2).Resize(.Rows.Count, .Columns.Count - 1)
semana = Range("a2")
columna = WorksheetFunction.Match(semana, .Rows(1), 0)
fecha_i = .Cells(2, columna): fecha_f = .Cells(3, columna)
End With
cuenta = WorksheetFunction.CountIfs(.Columns(1), ">=" & CDbl(fecha_i), .Columns(1), "<=" & CDbl(fecha_f))
If cuenta = 0 Then End
On Error Resume Next
fila = WorksheetFunction.Match(CDbl(fecha_i), .Columns(1), 0)
If cuenta > 0 And fila = Empty Then
fila = WorksheetFunction.Match(CDbl(fecha_i), .Columns(1), 1) + 1
End If
On Error GoTo 0
.Cells(fila, 2).Resize(cuenta, 1) = 1
End With
End Sub
