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.
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 de valedor
1