Resumen de acuerdo a macro

[sgdva]

Buen Día!

Tengo una pequeña duda con un macro.

Tengo estas condiciones a registrar

Orden de pedido en el mes Pedido Aceptacion (%) Responsable Causa 1 Causa 2 Causa 3 Causa 4

Ahora bien, categorizo la aceptación de acuerdo a excelente regular y baja con 3 colores verde, naranja y rojo.

El problema es que quiero hacer un resumen de cuál fue la orden de pedido en el mes que tuvo mejor de aceptación y cuales son las peores de regular y baja, que me diga el responsable, el pedido, las causas... todos los datos de la orden digamos.

Adjunto el archivo para explicarme mejor y dejar la referencia, saludos.

Resultados resumidos.xls

[Antoni]

Hola:

Coloca la macro en la hoja Mes.

Cada vez que modifiques un valor, se recalculará el resumen de forma automática.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim R As Worksheet, D9 As Double, D10 As Double, D11 As Double



Application.ScreenUpdating = False

Set R = Sheets("Resumen de ordenes")

R.Range("D9:N11") = ""

D9 = 0: D10 = 1: D11 = 1


For x = 4 To Range("C" & Rows.Count).End(xlUp).Row


'Verdes

   If Range("B" & x).Interior.Color = R.Range("D9").Interior.Color Then

      If Not Range("D" & x) < D9 Then

         Range("B" & x & ":I" & x).Copy R.Range("G9")

         D9 = Range("D" & x)

      End If

      R.Range("D9").Value = R.Range("D9").Value + 1

   End If


'Naranjas

   If Range("B" & x).Interior.Color = R.Range("D10").Interior.Color Then

      If Not Range("D" & x) > D10 Then

         Range("B" & x & ":I" & x).Copy R.Range("G10")

         D10 = Range("D" & x)

      End If

      R.Range("D10").Value = R.Range("D10").Value + 1

   End If


'Rojos

   If Range("B" & x).Interior.Color = R.Range("D11").Interior.Color Then

         If Not Range("D" & x) > D11 Then

         Range("B" & x & ":I" & x).Copy R.Range("G11")

         D11 = Range("D" & x)

      End If

      R.Range("D11").Value = R.Range("D11").Value + 1

   End If


Next


End Sub[/CODE]

[sgdva]

Gracias por la respuesta!

Por colocarlo en la hoja mes, te refieres a colocar esto antes del private sub?

Sub Resumen()    

    With Sheets("Mes")

        (aquí pego tu código)

    End With[/CODE]

[Antoni]

No, Alt+F11, doble click en Hoja("Mes") y ahí pegas el código tal como te lo he dejado.

Para probar modifica cualquiercelda de la hoja "Mes".

Si tienes problemas, sube el archivo real y te lo incluyo.

[sgdva]

Justo lo que necesitaba!

Modificado un poco (en el rango de las celdas) pero espero pueda ser a alguien de utilidad!

Y si hubiera otro criterio que también habría que analizar en vez de porcentaje a algún otro numero en la columna F?

Muchas Gracias!

Resultados resumidos(1).xls