Ayuda para gestionar un documento con días de la semana en el programa Microsoft Excel

La pregunta es la siguiente:
En el siguiente código que pongo al final de la pregunta tengo que añadir las líneas necesarias para que cuando solo se ponga un día de la semana solo me coloque 1 en el lugar correspondiente, tal y como lo hace actualmente, pero... Cuando hayan más de un 1 en la misma línea me divida la cantidad de números unos que hay (de lunes a domingo) y el resultado me lo ponga en los lugares que antes había un 1, ejemplo:
En la columna L he colocado un lunes y en la columna M un jueves, con esto se completarían las columnas N, O, P, QUE añadiendo un 1 en cada una, bueno, pues lo que necesito es que me divida 1 entre 4 ( correspondiente a un 1 por cada día desde lunes a jueves) y que el resultado de la división "0,25", me lo ponga en cada día desde lunes hasta jueves. ¿Crees qué es muy complicado?.
Public Sub VerificarDias()
Dim UltimaFila As Long
Dim DiaUno As Integer
Dim DiaDos As Integer
Dim co1 As Long, co2 As Integer
'Esta constante te sera util si llegas a insertar mas columnas
'entre las columnas A y B y las columnas donde estas los dias
'de la semana que por ahora los tienes de E a K
'el nº es la columna anterior a donde comenzará a insertarse los datos osea, la 14
Const COLUMNA As Integer = 13
'Garantizamos que haya datos en la columna A o B
UltimaFila = Range("L65536").End(xlUp).Row '
If UltimaFila < Range("M65536").End(xlUp).Row Then
UltimaFila = Range("M65536").End(xlUp).Row
End If
'Garantizamos que haya minimo una fila de datos
If UltimaFila > 1 Then
'Iteramos desde la fila 2 y hasta donde haya datos, no tiene
'caso recorrer TODAS las filas, solo las que tengan datos
Application.ScreenUpdating = False
For co1 = 2 To UltimaFila
'Obtenemos los dias de la semana
DiaUno = DiaSemana(UCase(Trim(Cells(co1, 12).Value)))
DiaDos = DiaSemana(UCase(Trim(Cells(co1, 13).Value)))
Application.StatusBar = "Procesando el registro " & Format(co1 - 1)
If DiaUno > 0 Or DiaDos > 0 Then
If DiaUno = 0 Then DiaUno = DiaDos
If DiaDos = 0 Then DiaDos = DiaUno
If DiaUno = DiaDos Then
Cells(co1, DiaUno + COLUMNA).Value = 1
ElseIf DiaDos > DiaUno Then
For co2 = DiaUno + COLUMNA To DiaDos + COLUMNA
Cells(co1, co2).Value = 1
Next co2
Else
co2 = DiaUno + COLUMNA
Do
DoEvents
Cells(co1, co2).Value = 1
If co2 = 7 + COLUMNA Then
co2 = 1 + COLUMNA
Else
co2 = co2 + 1
End If
Loop Until co2 = DiaDos + 1 + COLUMNA
End If
End If
Next co1
Application.StatusBar = False
Application.ScreenUpdating = True
End If
End Sub
'Funcion que nos dice que dia se la semana le corresponde en numero
Private Function DiaSemana(ByVal Dia As String) As Integer
Dim intDia As Integer
Select Case Dia
Case "LUNES", "lunes": intDia = 1
Case "MARTES", "martes": intDia = 2
Case "MIÉRCOLES", "MIERCOLES", "miércoles", "miercoles": intDia = 3
Case "JUEVES", "jueves": intDia = 4
Case "VIERNES", "viernes": intDia = 5
Case "SABADO", "SÁBADO", "sábado", "sabado": intDia = 6
Case "DOMINGO", "domingo": intDia = 7
Case Else: intDia = 0
End Select
DiaSemana = intDia
End Function
Mil Gracias por tu paciencia y ayuda.

1 respuesta

Respuesta
1
No es complicado, pero siento que me haces trabajar de más, si me hubieses planteado esto desde el principio tal ves se habría hecho de otra manera, por lo pronto solo adapte la que ya te había hecho, observa que también le cambie el nombre a la macro, el archivo completo te lo envío a tu correo, en cuanto se restablezca el servicio, la función DiaSemana no se modifico, saludos...
Public Sub AnalizarDias()
Dim UltimaFila As Long
Dim DiaUno As Integer
Dim DiaDos As Integer
Dim co1 As Long, co2 As Integer
Dim Divisor As Integer
Dim mDias() As Integer
Const COLUMNA As Integer = 13
'Garantizamos que haya datos en la columna A o B
UltimaFila = Range("L65536").End(xlUp).Row '
If UltimaFila < Range("M65536").End(xlUp).Row Then
UltimaFila = Range("M65536").End(xlUp).Row
End If
'Garantizamos que haya minimo una fila de datos
If UltimaFila > 1 Then
'Iteramos desde la fila 2 y hasta donde haya datos, no tiene
'caso recorrer TODAS las filas, solo las que tengan datos
Application.ScreenUpdating = False
For co1 = 2 To UltimaFila
'Obtenemos los dias de la semana
DiaUno = DiaSemana(UCase(Trim(Cells(co1, 12).Value)))
DiaDos = DiaSemana(UCase(Trim(Cells(co1, 13).Value)))
Application.StatusBar = "Procesando el registro " & Format(co1 - 1)
If DiaUno > 0 Or DiaDos > 0 Then
If DiaUno = 0 Then DiaUno = DiaDos
If DiaDos = 0 Then DiaDos = DiaUno
If DiaUno = DiaDos Then
Cells(co1, DiaUno + COLUMNA).Value = 1
ElseIf DiaDos > DiaUno Then
Divisor = DiaDos - DiaUno + 1
For co2 = DiaUno + COLUMNA To DiaDos + COLUMNA
Cells(co1, co2).Value = 1 / Divisor
Next co2
Else
co2 = DiaUno + COLUMNA
ReDim mDias(0)
Do
DoEvents
mDias(UBound(mDias)) = co2
If co2 = 7 + COLUMNA Then
co2 = 1 + COLUMNA
Else
co2 = co2 + 1
End If
ReDim Preserve mDias(UBound(mDias) + 1)
Loop Until co2 = DiaDos + 1 + COLUMNA
Divisor = UBound(mDias)
ReDim Preserve mDias(UBound(mDias) - 1)
For co2 = LBound(mDias) To UBound(mDias)
If Divisor = 0 Then
Cells(co1, mDias(co2)).Value = 1
Else
Cells(co1, mDias(co2)).Value = 1 / Divisor
End If
Next co2
Erase mDias
End If
End If
Next co1
Application.StatusBar = False
Application.ScreenUpdating = True
End If
End Sub
Mauricio

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas