Excel - BUSCAR EN RANGO, MENOR VALOR CON CONDICIONES Y ARROJAR TEXTO

Option Explicit

Option Private Module

Option Base 1

'//By JuanC - Oct. 2014

'//(A)(B)(C) Sólo son válidos si la tabla está ordenada por productos.

'//(cada línea reduce el rango de productos para mayor velocidad de trabajo)...

Type mt

     sRef As String

     dCosto As Double

End Type

Private Const cOCULTO = "oculto"

Private Const cVISIBLE = "visible"

Sub main()

With Application

    .ScreenUpdating = False

    .EnableEvents = False

    .Calculation = xlCalculationManual

End With

Call vo(Range("F4:F18"))  '//Rango de Valor esperado...

With Application

    .ScreenUpdating = True

    .EnableEvents = True

    .Calculation = xlCalculationAutomatic

End With

End Sub

Private Sub vo(ByVal rng As Range)

Dim cell As Range, cell2 As Range, rngProducto As Range

Dim vit() As mt, n&, min#, i&, sProducto$

rng.Value = ""

Set rngProducto = rng.Cells(1, 1).Offset(, -2).Resize(rng.Count) '//Rango de productos...

For Each cell In rng    '//Rango de valor Esperado...

    With cell

         If .Value <> "" Then GoTo siga          '//Valor esperado ya completado ('oculto'/'visible')...

            If .Offset(0, -4).Value <> 1 Then    '//Sin existencia...

               .Value = cOCULTO

               If rngProducto.Count > 1 Then Set rngProducto = rngProducto.Resize(rngProducto.Count - 1).Offset(1) '(A)

            Else

                If .Offset(0, -3).Value = 1 Then '//Existe, ¿único proveedor?...

                   .Value = cVISIBLE

                   If rngProducto.Count > 1 Then Set rngProducto = rngProducto.Resize(rngProducto.Count - 1).Offset(1) '(B)

                Else

                    sProducto = .Offset(, -2).Value '//Producto a evaluar...

                    n = 0

                    min = 100000000

                    For Each cell2 In rngProducto

                        If n >= .Offset(, -3).Value Then Exit For  '//Alcanzó repeticiones del producto...

                        If sProducto = cell2.Value Then            '//¿Mismo producto?...

                           n = n + 1

                           ReDim Preserve vit(n)

                           vit(n).dCosto = cell2.Offset(, 1).Value          '//Guarda costo del producto y referencia de 'Valor esperado' para el producto...

                           vit(n).sRef = cell2.Offset(0, 2).Address(0, 0)

                           If vit(n).dCosto < min Then min = vit(n).dCosto  '//Calcula costo mínimo...

                        End If

                    Next

                    For i = 1 To UBound(vit)         '//Completa Valor esperado para el grupo de productos basado en el costo mínimo...

                        If vit(i).dCosto = min Then

                           Range(vit(i).sRef) = cVISIBLE

                        Else

                             Range(vit(i).sRef) = cOCULTO

                        End If

                    Next

                    If rngProducto.Count > n Then Set rngProducto = rngProducto.Resize(rngProducto.Count - n).Offset(n) '(C)

            End If

         End If

    End With

siga:

Next

Erase vit

End Sub