Saltar al contenido

Permitir desbordamiento en fórmulas


Recommended Posts

publicado

Hola buenas,

 

Tengo el siguiente problema, quiero utilizar la formula UNICOS en VBA para sacar los resultados únicos de una columna (columna que tiene el nombre de "Soporte" asignado) de una tabla.

El código de VBA es el siguiente:

ActiveCell = Application.WorksheetFunction.Unique([Soporte])

El problema que tengo, es que solo me devuelve un resultado cuando el resultado que necesito deberían ser varios, pero imagino que en el código VBA al referirme a una única celda solo me devuelve un resultado.

En cambio en excel al utilizar la funcion únicos, como permite desbordamiento me devuelve todos los resultados que necesito uno debajo de otro.

=UNICOS(Soporte)

Como puedo ,utilizando la función en VBA, permitir ese  desbordamiento? Siempre y cuando sea posible por supuesto.

En la imagen adjunto una captura del documento, el resultado que quiero es el que empieza en F5, y el resultado que obtengo con VBA es que me devuelve un único soporte (E5).

Mi intención es realizarlo desde VBA

Muchas gracias de antemano.

CapturaExcel.thumb.jpg.2c4695ade35ab4ace1b68d94a1dd4131.jpg

publicado

Hola

No confundir funciones con WorksheetFunctions, no son exactamente lo mismo. En VBA al generarse una matriz/array, hay que tratarlo como tal:

Sub misunicos()

Dim mimatriz As Variant
Dim x As Long

mimatriz = Application.WorksheetFunction.Unique(Range("B5:B13"))
x = UBound(mimatriz, 1)
Range("G5:G" & 5 + x - 1).Value = mimatriz

End Sub

Saludos

publicado

Lo mismo que te ha contado Abraham, pero teniendo en cuenta la tabla.

Sub ListarÚnicos()
Dim Únicos As Variant
Únicos = WorksheetFunction.Unique(ListObjects(1).DataBodyRange.Columns(1))
Range("G5").Resize(UBound(Únicos), 1) = Únicos
End Sub

 

publicado
En 26/12/2023 at 18:39 , Abraham Valencia dijo:

Hola

No confundir funciones con WorksheetFunctions, no son exactamente lo mismo. En VBA al generarse una matriz/array, hay que tratarlo como tal:

Sub misunicos()

Dim mimatriz As Variant
Dim x As Long

mimatriz = Application.WorksheetFunction.Unique(Range("B5:B13"))
x = UBound(mimatriz, 1)
Range("G5:G" & 5 + x - 1).Value = mimatriz

End Sub

Saludos

 

En 26/12/2023 at 19:13 , Antoni dijo:

Lo mismo que te ha contado Abraham, pero teniendo en cuenta la tabla.

Sub ListarÚnicos()
Dim Únicos As Variant
Únicos = WorksheetFunction.Unique(ListObjects(1).DataBodyRange.Columns(1))
Range("G5").Resize(UBound(Únicos), 1) = Únicos
End Sub

 

Buenas,

Muchísimas gracias Antoni y Abraham por responder.

Tengo una duda mas, ¿y si quiesiera introducir con VBA directamente la fórmula en la celda?

He utilizado el siguiente código:

Range("G5").Formula = "=UNICOS(Soporte)"

El problema que tengo es que cuando ejecuto el código, en la celda me aparece esta función:

=@UNICOS(Soporte)

Imagino que al incluir "@" lo que hace es referirse a una única celda por lo que me da el error de #¡VALOR! ya que al tener ese "@" imagino que no permite el desbordamiento. Pero si manualmente le quito ese "@" me da el resultado correcto, ya que permite el desbordamiento.

¿Como puedo hacer para introducir esa fórmula desde VBA sin el dichoso "@"?

Todavía no estoy seguro si lo usaré desde VBA o si escribiré la fórmula en la celda.

Muchas gracias de antemano y un saludo!

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
    • Podrías compartir tu solucion
    • Alguien me apoya a cerrar este tema,  ya lo solucioné Gracias
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.