Distribución y creación de campos VB Excel
1 Respuesta
![]()
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
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 Subsal 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.
- Compartir respuesta