Contar por años y meses en funcion de otra columna y rellenar en otra hoja

[gogua]

Hola!

Para ser el primer tema sobre el que pido ayuda, empiezo fuerte, al menos para mi lo es.

El caso es que tengo un libro excel con varias hojas una de ellas tiene los datos los cual quiero explotar para luego sacar ciertas estadísticas. Y no se me ocurre otra forma que no sea con macros-vba. pero he intentado hacer algun ciclo anidado con for, pero me estoy volviendo loco.

Del libro que adjunto, el objetivo es:

Coger de la hoja datos y sumar por años y por meses los valores que la columna Dato1 sea "Si" y rellenar la hoja Copia según muestro en el libro, pero de forma automática, cada vez que se haga un cambio en la hoja Datos. La hoja datos se va alimentando de forma manual todos los días.

 

Del codigo que aparece en el modulo de VBA, no hagáis mucho caso porque son intentos fallidos de dar con la solución.

 

Hoja Datos:

 

Hoja Copia (Como debería quedar):

 

Muchas gracias por la ayuda de antemano.

 

 

 

 

Contar por 2 columnas.xlsm

[Antoni]

Abre el adjunto y pulsa sobre la flecha azul.

Contar por 2 columnas.xlsm

[gogua]

Hace 18 minutos , Antoni dijo:

Abre el adjunto y pulsa sobre la flecha azul.

Contar por 2 columnas.xlsm 32.47 kB · 0 descargas

Muchas gracias Antoni,

Si quisiera añadir en el resultado final también los meses en los que no hay ninguna coincidencia, vamos los que serían 0 en el contaje? tal como ponía yo en el supuesto resultado final?, para que quedasen los datos completos de todos los meses...

 

 

[Antoni]

Prueba con la macro modificada:

Sub ContarPorMeses()
Dim fMax As Date, fMin As Date
Set Datos = Sheets("Datos")
Set Copia = Sheets("Copia")
Application.ScreenUpdating = False
With Copia
   .[A:C].ClearContents
   For x = 2 To Datos.[A1].End(xlDown).Row
      If UCase(Datos.Range("I" & x)) = "SI" Then
         Fila = Fila + 1
         .Range("E" & Fila) = Year(Datos.Range("D" & x)) & _
                              Format(Month(Datos.Range("D" & x)), "00")
      End If
   Next
   .Columns("E").Sort Key1:=.Columns("E")
   fMin = WorksheetFunction.Min(Datos.Columns("D"))
   fMin = CDate("01/" & Month(fMin) & "/" & Year(fMin))
   fMax = WorksheetFunction.Max(Datos.Columns("D")) + 1
   Fila = 0
   Do Until fMin > fMax
      Fila = Fila + 1
      .Range("F" & Fila) = Year(fMin) & _
                           Format(Month(fMin), "00")
      fMin = DateAdd("m", 1, fMin)
   Loop
   .Range("A1") = "AÑO": .Range("B1") = "MES": .Range("C1") = "SUMA"
   Fila = 1
   For x = 1 To .[F1].End(xlDown).Row
      Fila = Fila + 1
      .Range("A" & Fila) = Left(.Range("F" & x), 4)
      .Range("B" & Fila) = UCase(MonthName(Right(.Range("F" & x), 2)))
      .Range("C" & Fila) = Evaluate("=COUNTIF(Copia!E:E," & .Range("F" & x) & ")")
   Next
   .[E:F].Clear
   .Select
End With
End Sub

 

[gogua]

En 12/3/2021 at 18:02 , Antoni dijo:

Prueba con la macro modificada:

Sub ContarPorMeses()
Dim fMax As Date, fMin As Date
Set Datos = Sheets("Datos")
Set Copia = Sheets("Copia")
Application.ScreenUpdating = False
With Copia
   .[A:C].ClearContents
   For x = 2 To Datos.[A1].End(xlDown).Row
      If UCase(Datos.Range("I" & x)) = "SI" Then
         Fila = Fila + 1
         .Range("E" & Fila) = Year(Datos.Range("D" & x)) & _
                              Format(Month(Datos.Range("D" & x)), "00")
      End If
   Next
   .Columns("E").Sort Key1:=.Columns("E")
   fMin = WorksheetFunction.Min(Datos.Columns("D"))
   fMin = CDate("01/" & Month(fMin) & "/" & Year(fMin))
   fMax = WorksheetFunction.Max(Datos.Columns("D")) + 1
   Fila = 0
   Do Until fMin > fMax
      Fila = Fila + 1
      .Range("F" & Fila) = Year(fMin) & _
                           Format(Month(fMin), "00")
      fMin = DateAdd("m", 1, fMin)
   Loop
   .Range("A1") = "AÑO": .Range("B1") = "MES": .Range("C1") = "SUMA"
   Fila = 1
   For x = 1 To .[F1].End(xlDown).Row
      Fila = Fila + 1
      .Range("A" & Fila) = Left(.Range("F" & x), 4)
      .Range("B" & Fila) = UCase(MonthName(Right(.Range("F" & x), 2)))
      .Range("C" & Fila) = Evaluate("=COUNTIF(Copia!E:E," & .Range("F" & x) & ")")
   Next
   .[E:F].Clear
   .Select
End With
End Sub

 

Muchas gracias por la respuesta, he estado desconectado, por eso la tardanza.