1

1 Respuesta

4.317.950 pts. Sancho, si los perros ladran ...

Te envié la macro para distribuir en turno y sala. Para realizar la distribución por persona, tengo que ver en dónde vas a poner el número de personas, en qué columna están las personas y en dónde quieres el turno y sala. Podrías poner una imagen de cómo quieres el resultado.

En la "Hoja1", celda C5 pondré el número de asistentes. Y en la "Hoja2" necesito que la macro que cree este tipo de distribución:

En la columna A deberán aparecer los asistentes ordenados numéricamente

En la columna B el turno al que irán. En este caso, 1 ó 2

En la columna C la sala que le corresponda (de 1 a 16)

Con la particularidad ya mencionada. Las primeras salas que deben completarse con 4 asistentes deben ser las del turno 1 y conforme va minorando su número la ocupación de las salas será de 3 empezando por el turno 2 hasta completarlo y pasando a minorar las del turno 1 en último lugar (esto ocurre cuando el número de asistentes es igual o inferior a 111)

Muchísimas gracias

Te anexo la macro para este modelo:

Asistentes de 96 hasta 128, salas 16, asistentes/sala 4, asistentes/turno 64

Que corresponde al sistema de ecuaciones:

x + y = 16

4x + 3y = n

n = número de asistentes


Si cambias el número de salas o de asistentes o de asistentes por turno, tendría que resolver el sistema de ecuaciones; o más bien, tendría que hacer una macro que pudiera resolver cualquier combinación.

Pero por lo pronto te anexo la macro para el modelo comentado: asistentes 96 hasta 128, salas 16, asistentes/sala 4, asistentes/turno 64


Para su funcionamiento requieres 3 hojas, Hoja1 con los datos del modelo, Hoja2 tendrá el resultado y la Hoja3 es temporal.

Sub Distribuir2()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    Set h3 = Sheets("Hoja3")    'temp
    h2.Range("A2:C" & Rows.Count).ClearContents
    h3.Cells.Clear
    per_t = h1.[C5]         'personas totales
    sal_t = h1.[C6]         'salas
    axs_t = h1.[C7]         'asistentes por sala
    axt_t = h1.[C8]         'asistentes por turno
    '
    h3.Range("C4:C19") = ""
    h3.Range("E4:E19") = ""
    per_1 = 16 * 4          'personas sala 1
    'validaciones
    If per_t > 128 Then
        MsgBox "Número máximo permitido 128"
        Exit Sub
    End If
    '
    If per_t < 96 Then
        MsgBox "Número mínimo permitido 96"
        Exit Sub
    End If
    '
    'Proceso
    If per_t >= 112 Then
        h3.Range("A4:A19") = 4
        per2 = per_t - per_1
        col = 2
    Else
        h3.Range("B4:B19") = 3
        per2 = per_t - 48
        col = 1
    End If
    x = per2 - 48
    y = 16 - x
    j = 4
    For i = 1 To x
        h3.Cells(j, col) = 4
        j = j + 1
    Next
    For i = 1 To y
        h3.Cells(j, col) = 3
        j = j + 1
    Next
    '
    fila = 2
    conse = 1
    sala = 1
    For turno = 1 To 2
        For j = 4 To 19
            For k = 1 To h3.Cells(j, turno)
                h2.Cells(fila, "A") = conse
                h2.Cells(fila, "B") = turno
                h2.Cells(fila, "C") = sala
                fila = fila + 1
                conse = conse + 1
            Next
            sala = sala + 1
        Next
        sala = 1
    Next
    MsgBox "fin"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Buenos días

en mi hoja1 pongo mi tablita de asistentes, salas, etc

en la hoja2 pong los nombres de los campos: orden, turno y sala

dejo la hoja3 en blanco

Y grabo el libro

Alt+F11 y añado un módulo donde pego el último código que me has dado

Al ejecutarlo me salta una pantallita para que cree una macro

¿en qué me estoy equivocando?

gracias de nuevo

La macro que debes ejecutar se llama Distribuir2

Revisa bien el nombre

Avísame cualquier detalle

Hola,

Salta mensaje "error de compilación. No se ha definido Sub o función"

Y se queda marcado  Set h1  =  Sheets("Hoja1")

¿Tienes esta instrucción "Option Explicit"?

¿O activaste "Requerir declaración de variables"?

¿Qué versión de excel tienes?

¿Es de windows?

Agrega las líneas Dim

Sub Distribuir2()
'Por.Dante Amor
    Dim h1, h2, h3, per_t, per_1, per2, sal_t, axs_t, axt_t
    Dim i, j, k, x, y, col, fila, conse, sala, turno
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    Set h3 = Sheets("Hoja3")    'temp
    h2.Range("A2:C" & Rows.Count).ClearContents
    h3.Cells.Clear
    per_t = h1.[C5]         'personas totales
    sal_t = h1.[C6]         'salas
    axs_t = h1.[C7]         'asistentes por sala
    axt_t = h1.[C8]         'asistentes por turno
    '
    h3.Range("C4:C19") = ""
    h3.Range("E4:E19") = ""
    per_1 = 16 * 4          'personas sala 1
    'validaciones
    If per_t > 128 Then
        MsgBox "Número máximo permitido 128"
        Exit Sub
    End If
    '
    If per_t < 96 Then
        MsgBox "Número mínimo permitido 96"
        Exit Sub
    End If
    '
    'Proceso
    If per_t >= 112 Then
        h3.Range("A4:A19") = 4
        per2 = per_t - per_1
        col = 2
    Else
        h3.Range("B4:B19") = 3
        per2 = per_t - 48
        col = 1
    End If
    x = per2 - 48
    y = 16 - x
    j = 4
    For i = 1 To x
        h3.Cells(j, col) = 4
        j = j + 1
    Next
    For i = 1 To y
        h3.Cells(j, col) = 3
        j = j + 1
    Next
    '
    fila = 2
    conse = 1
    sala = 1
    For turno = 1 To 2
        For j = 4 To 19
            For k = 1 To h3.Cells(j, turno)
                h2.Cells(fila, "A") = conse
                h2.Cells(fila, "B") = turno
                h2.Cells(fila, "C") = sala
                fila = fila + 1
                conse = conse + 1
            Next
            sala = sala + 1
        Next
        sala = 1
    Next
    MsgBox "fin"
End Sub

sal u dos

Hola,

Perdón por el retraso. He estado trabajando con un código que me han pasado. ¿Cómo podría pasarte mi archivo para que le echaras un vistazo y trabajaras sobre él? si es posible demandarte esto, claro

Gracias

¿Demandarte o de mandarte?

Si vas a demandar con abogados, entonces ya no juego.

Si vas a mandar, entonces

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “ladyserenity” y el título de esta pregunta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas