DiegoLG

estimado @pinoji
la verdad sin archivo es dificil de hacer pruebas, deberias de adjuntar aunque sea un pequeño ejemplo:

te mando el codigo corregido, (Nota: sin realizar pruebas)
 

Sub InsertarCuentaOrdenada()
    Dim wsCatalogo As Worksheet
    Dim ultimaFila As Long
    Dim nivelCuenta As String
    Dim nuevaCuenta As String
    Dim tituloCuenta As String
    Dim naturalezaCuenta As String
    Dim i As Long
    Dim filaInsertar As Long
    Dim cuentaEncontrada As Boolean
    
    Set wsCatalogo = ThisWorkbook.Sheets("Plan de Cuentas")
    ultimaFila = wsCatalogo.Cells(wsCatalogo.Rows.Count, 1).End(xlUp).Row

    ' Pedir datos
    nivelCuenta = InputBox("Ingrese la categoría jerárquica de la cuenta:")
    nuevaCuenta = InputBox("Ingrese el código de la nueva cuenta (ej: 102-03):")
    tituloCuenta = InputBox("Ingrese el Título de la cuenta:")
    naturalezaCuenta = InputBox("Ingrese la Naturaleza de la cuenta (D/H):")
    
    cuentaEncontrada = False
    filaInsertar = ultimaFila + 1 ' Por defecto, al final
    
    ' Buscar dónde insertar
    For i = 3 To ultimaFila
        If wsCatalogo.Cells(i, 1).Value = nivelCuenta Then
            If wsCatalogo.Cells(i, 2).Value > nuevaCuenta Then
                filaInsertar = i
                cuentaEncontrada = True
                Exit For
            End If
        End If
    Next i
    
    ' Insertar fila y datos
    wsCatalogo.Rows(filaInsertar).Insert Shift:=xlDown
    wsCatalogo.Cells(filaInsertar, 1).Value = nivelCuenta
    wsCatalogo.Cells(filaInsertar, 2).Value = nuevaCuenta
    wsCatalogo.Cells(filaInsertar, 3).Value = tituloCuenta
    wsCatalogo.Cells(filaInsertar, 4).Value = naturalezaCuenta
    
    MsgBox "Cuenta insertada correctamente y ordenada.", vbInformation
End Sub

Código original

• Insertaba la nueva cuenta justo debajo de la primera coincidencia de jerarquía (columna A).

• No respetaba el orden numérico de los códigos de cuenta (columna B).

• Resultado: cuentas nuevas podían quedar fuera de orden lógico (ej: 102-03 podía quedar arriba de 102-02).

Código corregido

• Busca todas las cuentas con la jerarquía indicada.

• Compara el código de la nueva cuenta con los existentes y encuentra su posición correcta dentro de esa jerarquía.

• Inserta la cuenta en ese punto, manteniendo el orden numérico.

Espero haberte ayudado,

Saludos,

Si tienes office 365 puedes usar algo como FILTER ó TEXTJOIN

y si no tienes, entonces se puede jugar con las formulas, pero no te recomiendo mucho si son muchos datos,

de todas maneras te dejo una fórmula y en vba, ya tu decides cual ocupar, vale

Saludos

BUSCAR.xlsm

En 17/4/2025 at 11:17 , JSDJSD dijo:

Podrías compartir tu solucion

@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

Alguien me apoya a cerrar este tema, 
ya lo solucioné

Gracias

Hola mis amigos, como se encuentran,

Antes que nada, gracias por tomarte el tiempo de leer mi situación.

Tengo una tabla en donde se surte mercancía, el detalle esta:  Como son varios pedidos entonces, es donde se me complica un poco, a veces el cliente me pide cierta cantidad de mercancía, como no es el único, entonces quiero ver la posibilidad de mejorar este proceso, me gustaría ver si hay la posibilidad de combinar estas dos opciones, en donde si mi stock de acuerdo al pedido no cumple, entonces que surte a ciertos clientes, y la otra opción sería si de mi stock no cumple entonces que me distribuye en partes iguales la mercancía.

Adjunto un archivo de ejemplo para mejor apreciación.

De antemano, muchas gracias.

SURTIDO DE MERCANCIAS.xlsx

Sube un archivo de ejemplo @pato10x 

Que tal amigos, solo pase a saludarlos, apenas estoy de regreso de nuevo.

tanto tiempo.

feliz noche a todos