Toda la actividad

@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

Hola, He reunido la solución en 1 único archivo, con 2 hojas equivalentes al contenido de cada uno de los 2 libros. Con esta simplificación, podría servirte una fórmula de este diseño: =MAP(B3:B156;LAMBDA(x;SI.ND(DESREF(Fct!E1;COINCIDIR(x;Fct!B3:B156;)+CONTAR.SI(B3:x;x););""))) que colocada en la hoja 'Control' devolvería los resultados que supongo esperas obtener. Revisa el archivo adjunto, que te dará una idea de cómo reconstruir la fórmula, añadiendo los links externos del archivo origen en el archivo destino. Saludos, Fct (B).xlsx

Hola a toda la comunidad. Me encuentro en busca de ayuda con lo siguiente. Tengo 2 libros (uno se llama Fct y el otro Cotrol). En ambos tengo las columnas Cert nro y montos. Quiero que en el libro Ctrol me busque por nro de certificado y me traiga el monto del libro Fct. Como tengo certificados que repiten su numeración, si utilizo Buscarv me va a traer el mismo resultado para todos ya que devuelve el 1er valor que encuentra. Porbe con INDICE COINCIDIR y no le pego, También con la función FILTRAR y tampoco le encuentro la vuelta. Agradeceré la ayuda qu eme puedan brindar. Subo ambos archivos de referencia Ejemplo ayuda Ctrol.xlsx Ejemplo ayuda Fct.xlsx

Muchas gracias por tu respuesta Abraham. Saludos!

Hola, el ícono de Excel es cuando vinculas los datos de Excel, tipo tablas es cuando importas.

Estimados, cómo están? Junto con saludar, tengo una duda existencial de porque bases que importo a través de ACCESS de distintos archivos Excel, la vista o icono se ven de la siguiente manera (2025 se ve como una mini tabla, mientras 2011 se ve como una extensión xlsx). A raíz de lo anterior, me gustaría saber que se tiene que hacer para que el ícono de la tabla 2025 se vea similar a la del 2011. De antemano, muchísimas gracias! Saludos

Prueba ahora RCI PRUEBA2.xlsm

Saludos @JSDJSD espero estes bien agradecido como siempre por sus oportunas y acertadas respuestas Se solvento lo de la copia de datos del ListBox1 al TextBox3, sin embargo, ahora cuando se guardan los datos se activa el MsgBox "Datos Incompletos: Seleccione un Código", cosa que no sucedía en el archivo original: Private Sub ListBox1_Click(): On Error Resume Next 'Alertas del Sistema If ComboBox1 = "" Then ListBox1 = Enabled MsgBox "Datos Incompletos: Seleccione un Código", vbExclamation Exit Sub End If End sub Dicho MsgBox debe de activarse única y exclusivamente cuando se intente seleccionar un caso en el ListBox1 y el ComboBox1 = "" y no debería activarse cuando se guarde la información, solventando este único y último detalle se podría dar por cerrada esta consulta.

RCI PRUEBA2.xlsm

Prueba y comenta

Saludos @JSDJSD espero estes bien gracias por la solución que propuso para mi pregunta. Tome el archivo con sus correcciones y al descargarlo verifique no posee una funcionalidad que si estaba en el archivo original de mi pregunta en concreto tiene que ver con la información que debería mostrarse en el TextBox2 de allí que: Cuando selecciono el código y hago click sobre en el Listbox1 los datos se copian correctamente en los TextBox3 y TextBox5 pero en el TextBox2 no se copia ningun dato revisando me pude percatar que con la macros que agrego no se muestran datos en el TextBox2 a partir de la Columna "G" y cuando se suspende el funcionamiento de la Macro ComboBox1 si se muestran correctamente todos los datos en los TextBox2, 3 y 5 pero en el Listbox1 no se muestran exclusivamente los datos correspondientes al código que se selecciona en el ComboBox1, mientras que si se suspende el funcionamiento de la Macro BuscarYCargarEnListBox los datos se mostrados en el Listbox1 corresponden exclusivamente al código que se selecciona en el ComboBox1 dichos datos se copian correctamente en los TextBox3 y TextBox5 pero en el TextBox2 no se copia ningun dato

Tal y como tienes tu código hace lo siguiente, que es lo que necesitas?

El archivo RCI PRUEBA2.xlsm

Private Sub ComboBox1_Change() Dim hoja As Worksheet Dim fila As Long Dim ultimaFila As Long Dim columnas() As Variant Dim i, ii As Integer Dim codigo As String Dim encontrado As Boolean Set hoja = ThisWorkbook.Sheets("MATRIZ1") codigo = ComboBox1.Value ' Si ComboBox1 está vacío If ComboBox1.Value = "" Then UserForm_Initialize Exit Sub End If ' Si ComboBox1 tiene un valor (código) encontrado = False With ListBox1 ' Limpiar ListBox .RowSource = "" ' Definir ColumnCount para el ListBox .ColumnCount = 6 ' 6 columnas (B, C, D, E, F, M) ' Columnas específicas: B, C, D, E, F, M (números de columna) columnas = Array(2, 3, 4, 5, 6, 13) .ColumnWidths = "70;90;90;90;90;90;0;0;0;0;0;0;0;0" .ColumnHeads = False ' Agregar la cabecera al ListBox (desde la fila 4, columnas B, C, D, E, F, M) .AddItem hoja.Cells(4, columnas(0)).Value ' Columna B For ii = 1 To UBound(columnas) .List(0, ii) = hoja.Cells(4, columnas(ii)).Value ' Añadir encabezados de las otras columnas Next ii ' Determinar última fila con datos en la columna B ultimaFila = hoja.Cells(hoja.Rows.Count, "B").End(xlUp).Row ' Recorrer desde la fila 5 hacia abajo For fila = 5 To ultimaFila If hoja.Cells(fila, 2).Value = codigo Then ' Columna B encontrado = True ' Añadir nueva fila al ListBox (empieza en la segunda fila del ListBox) .AddItem hoja.Cells(fila, columnas(0)).Value ' Columna B For i = 1 To UBound(columnas) ' Asegurarse de que se estén agregando todos los valores correctamente .List(Me.ListBox1.ListCount - 1, i) = hoja.Cells(fila, columnas(i)).Value ' Rellenar las otras columnas Next i End If Next fila End With If Not encontrado Then MsgBox "No se encontró el código en la hoja.", vbInformation End If End Sub

Mañana te lo miro

Buenos días amigos espero estén bien Actualmente el Label92 me muestra el ratio que tardo en solventar un problema, sin embargo una vez que cierro un reporte y se guardan los datos el Label permanece con la información anterior y no se actualiza simultáneamente como si ocurre en el Listbox1, en concreto necesito que el Label92 se actualice de forma automática y simultánea una vez se guarden los datos RCI PRUEBA.xlsm

Saludos @JSDJSD espero este bien Tengo un caso similar al que le plantearon en ta pregunta: En concreto seria posible que al escoger cualquiera de los códigos alfanuméricos que se muestran en el ComboBox1 automaticamebte se efectue la búsqueda y en el ListBox1 se muestren exclusivamente los datos que correspondan con dicho código..? Mucho le sabre agradecer la ayuda que me pueda dar RCI PRUEBA.xlsm

Exelente funciona tal cual necesito

Solucionado! Libro2.xlsm

Aunque bien mirado... no sé si sería suficiente con igualar el color del texto al fondo. ¿Hay más opciones?