Calculo de fill rate con loop

[Luis Aquino]

Hola Cracks! De nuevo necesitando de su apoyo,

Tengo una tabla que me muestra el Fill Rate de ordenes de venta  que obtengo por la siguiente formula:

Cantidad facturada/Cantidad de Pedido

Cuando en una misma fila esta toda la cantidad facturada por toda la cantidad del pedido la formula corre bien y nos da el 100% ,el problema está cuando  una cantidad de pedido se divide entre varias cantidades facturadas se debe dividir todas por la misma cantidad de pedido,  se vería de esta forma:

Cantidad de Pedido   | Cantidad Facturada  | Fill Rate

858                                  396                                46%

0                                      129                                 15%

0                                      333                                 39%

 

El tema es que antes de hacer la división tiene que que comprobar que la cantidad de pedido es diferente a 0 , si es 0 debe correr un ciclo for que le reste -1  a la fila hasta que encuentre la fila de arriba (858) con un valor numérico para poder hacer la división y se le asigne un %.

Les dejo mi archivo con un link por We Transfer, espero me puedan ayudar. https://we.tl/t-FM5vlSr9sm

En la hoja BD es tal cual esta la tabla antes de aplicarle la macro.

En la hoja BD Solucion1de2 se aplica la primer corrección que seria ligar la cantidad facturada a la cantidad de pedido que le corresponde y no dividirlo por 0.

En la hoja BD Solucion2de2 se aplica la segunda corrección que seria eliminar todas las filas cuyo Fill Rate sea mayor a 100% porque seria un valor irreal.

[Antoni]

Prueba la macro, la solución en BD Solucion2de2, sin pasar por BD Solucion1de2.

Sub FillRate()
Application.ScreenUpdating = False
With Sheets("BD Solución2de2")
   Sheets("BD").Cells.Copy .Cells
   .Select
   For x = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If x Mod 500 = 0 Then Application.StatusBar = "Tratando fila " & x
      If Not .Range("A" & x) = "" Then
         If .Range("C" & x) > 0 Then Base = "C" & x
         .Range("I" & x).Formula = "=D" & x & "/" & Base
         If .Range("I" & x) > 1 Or .Range("I" & x) < 0 Then
            .Rows(x).Delete
            x = x - 1
         End If
      End If
   Next
End With
Application.StatusBar = False
End Sub

En la línea de estado de Excel se muestra un pequeño avance del proceso.