Automatizar la creación de un horario semanal -- vba campo con excel camp codereview Relacionados El problema

Automating the creation of a weekly schedule


2
vote

problema

Español

Estoy tratando de construir un libro de Excel para automatizar y ayudar a la creación de un horario de trabajo semanal.

Mi libro de trabajo actual es funcional, pero es lento, especialmente en una tarea en la que tengo una lista de personas con un horario anual que estoy buscando dos hojas al mismo tiempo.

Creo que hay una manera mejor y más eficiente que la que estoy usando.

  Option Explicit  'Global variable that will be in another module where i store all general config  Public Const PlanningAgentEmptyRange        As String = "C12:G58,F74:G78" 'Range agent present Public Const PosteWeekDayRange               As String = "B12:B72" 'Range agent present Public Const PosteWeekEndRange               As String = "B73:B78" 'Range agent present    Sub DraftFromCycle()  'If range is empty (to prevent the lost of approved schedule)  If Application.WorksheetFunction.CountA(Range(PlanningAgentEmptyRange)) = 0 Then   'list of day/col Weekday in weekly schedule Dim aWeekDay(1 To 5) As String aWeekDay(1) = "C": aWeekDay(2) = "D": aWeekDay(3) = "E": aWeekDay(4) = "F": aWeekDay(5) = "G"  'List of day/col weekEnd in weekly schedule Dim aWeekEnd(1 To 2) As String aWeekEnd(1) = "F": aWeekEnd(2) = "G"  Dim DayDate As Range Dim cel As Range Dim Col As Variant Dim DayRangeCycle As Range Dim DayCycleCol As String Dim DayCycleRow As Integer Dim AgentName Dim p, s, poste, x As variant Dim Cycle_lastrow As Integer Dim Cycle_lastcol As String   Cycle_lastrow = LastRow(Feuil55) Cycle_lastcol = LastCol(Feuil55)   'Loop col/Day  of weekday For Each Col In aWeekDay  Set DayDate = Range(Col & "11") Set s = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDate, Lookat:=xlWhole)            If Not s Is Nothing Then            DayCycleCol = ColLetter(s.Column)  For Each poste In Worksheets("Cycle").Range(DayCycleCol & "6:" & DayCycleCol & Cycle_lastrow)   Select Case poste  Case Is = "AM"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Après-midi", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "N"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Nuit", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "R N"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Récup Nuit", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "R Av"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.H. Avant Garde", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "R Ap"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.H. Après Garde", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "RTP"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.T.P.", Lookat:=xlWhole)     If Not x Is Nothing Then      Do         If ActiveSheet.Range(Col & x.Row) = "" Then         ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value         ActiveSheet.Range(Col & x.Row).Font.Italic = True         End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Else End Select  Next poste End If Next Col  'Loop col du Week End For Each Col In aWeekEnd  Set DayDate = Range(Col & "73") Set s = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDate, Lookat:=xlWhole)            If Not s Is Nothing Then            DayCycleCol = ColLetter(s.Column)  For Each poste In Worksheets("Cycle").Range(DayCycleCol & "6:" & DayCycleCol & Cycle_lastrow)   Select Case poste  Case Is = "AM"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="Après-midi", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "N"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="Nuit", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "6h25"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="6h25 - 13h25", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "7h30"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="7h30 - 14h30", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "7h45"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="7h45 - 14h45", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Else End Select  Next poste End If Next Col    End If End Sub   

Aquí hay una pantalla de lo que se ven las sábanas. El módulo toma los datos del calendario anual y automáticamente el horario semanal si está vacío:

horario anual (hojas de trabajo ("ciclo"))

horario anual (hojas de trabajo ("ciclo")

calendario semanal (hojas de trabajo ("1"))

Horario semanal (hojas de trabajo ("1")

Original en ingles

I'm trying to build an Excel workbook to automate and aid in the creation of a weekly work schedule.

My current workbook is functional, but it's slow - especially on one task where I have a list of people with an annual schedule that I'm searching two sheets at the same time.

I think there's a better and more efficient way than the one I'm using.

Option Explicit  'Global variable that will be in another module where i store all general config  Public Const PlanningAgentEmptyRange        As String = "C12:G58,F74:G78" 'Range agent present Public Const PosteWeekDayRange               As String = "B12:B72" 'Range agent present Public Const PosteWeekEndRange               As String = "B73:B78" 'Range agent present    Sub DraftFromCycle()  'If range is empty (to prevent the lost of approved schedule)  If Application.WorksheetFunction.CountA(Range(PlanningAgentEmptyRange)) = 0 Then   'list of day/col Weekday in weekly schedule Dim aWeekDay(1 To 5) As String aWeekDay(1) = "C": aWeekDay(2) = "D": aWeekDay(3) = "E": aWeekDay(4) = "F": aWeekDay(5) = "G"  'List of day/col weekEnd in weekly schedule Dim aWeekEnd(1 To 2) As String aWeekEnd(1) = "F": aWeekEnd(2) = "G"  Dim DayDate As Range Dim cel As Range Dim Col As Variant Dim DayRangeCycle As Range Dim DayCycleCol As String Dim DayCycleRow As Integer Dim AgentName Dim p, s, poste, x As variant Dim Cycle_lastrow As Integer Dim Cycle_lastcol As String   Cycle_lastrow = LastRow(Feuil55) Cycle_lastcol = LastCol(Feuil55)   'Loop col/Day  of weekday For Each Col In aWeekDay  Set DayDate = Range(Col & "11") Set s = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDate, Lookat:=xlWhole)            If Not s Is Nothing Then            DayCycleCol = ColLetter(s.Column)  For Each poste In Worksheets("Cycle").Range(DayCycleCol & "6:" & DayCycleCol & Cycle_lastrow)   Select Case poste  Case Is = "AM"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Aprxc3xa8s-midi", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "N"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Nuit", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "R N"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Rxc3xa9cup Nuit", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "R Av"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.H. Avant Garde", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "R Ap"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.H. Aprxc3xa8s Garde", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "RTP"     Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.T.P.", Lookat:=xlWhole)     If Not x Is Nothing Then      Do         If ActiveSheet.Range(Col & x.Row) = "" Then         ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value         ActiveSheet.Range(Col & x.Row).Font.Italic = True         End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Else End Select  Next poste End If Next Col  'Loop col du Week End For Each Col In aWeekEnd  Set DayDate = Range(Col & "73") Set s = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDate, Lookat:=xlWhole)            If Not s Is Nothing Then            DayCycleCol = ColLetter(s.Column)  For Each poste In Worksheets("Cycle").Range(DayCycleCol & "6:" & DayCycleCol & Cycle_lastrow)   Select Case poste  Case Is = "AM"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="Aprxc3xa8s-midi", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "N"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="Nuit", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "6h25"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="6h25 - 13h25", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "7h30"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="7h30 - 14h30", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Is = "7h45"     Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="7h45 - 14h45", Lookat:=xlWhole)     If Not x Is Nothing Then      Do          If ActiveSheet.Range(Col & x.Row) = "" Then          ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value          ActiveSheet.Range(Col & x.Row).Font.Italic = True          End If     Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)      Loop While Not x Is Nothing     End If   Case Else End Select  Next poste End If Next Col    End If End Sub 

Here's a screen of what the sheets look like. The module takes the data from the annual schedule and autofilled the weekly schedule if it's empty:

Annual Schedule (Worksheets("Cycle"))

Annual Schedule (Worksheets("Cycle")

Weekly Schedule (Worksheets("1"))

Weekly Schedule (Worksheets("1")

     

Lista de respuestas

1
 
vote
vote
La mejor respuesta
 

Observaciones generales


indentación

Lo primero que hice cuando cargué su código en el VBE iba a ejecutar un indentado. Sin una sangría consistente de bloques lógicos de código ( freq = 2 ** (note / 12) * 440; 8 , freq = 2 ** (note / 12) * 440; 9 Cuerpos, etc.), es increíblemente difícil obtener un identificador en lo que está haciendo el código. Especialmente si su 2 ** (3 / 12) * 440;0 es de 2010 líneas.


sintaxis de casos

usando 2 ** (3 / 12) * 440;1 es completamente redundante. 2 ** (3 / 12) * 440;2 es equivalente, más fácil de leer y ahorra una evaluación de expresión booleana. Además, no es necesario un 9988776655544332323 "vacío, no ejecuta ningún código, por lo que simplemente constituye un ruido al leer el bloque 2 ** (3 / 12) * 440;4 .


Declaraciones variables

Poner estos inmediatamente antes de su uso. Tener para desplazarse continuamente hasta la parte superior del 2 ** (3 / 12) * 440;5 para ver cómo se definen es tedioso. Operarán exactamente de la misma manera y serán mucho más legibles.

Además, la línea 2 ** (3 / 12) * 440;6 no está haciendo lo que cree que está haciendo. SOLO 2 ** (3 / 12) * 440;7 se declara explícitamente como 2 ** (3 / 12) * 440;8 . Los otros son implícitamente 2 ** (3 / 12) * 440;9 . Pero no hay ninguna razón para que cualquiera de estos no se escriba firmemente. Si bien no es una implicación importante de rendimiento, requiere una coerción de tiempo de ejecución en la mayoría de los lugares donde los usa.

Finalmente, dale a tus variables nombres significativos. Si estoy mirando a un procedimiento de línea de 201 y la única información que tengo (después de desplazarse hasta la parte superior) sobre note = Math.round(Math.log2(freq / 440) * 12); 0 es que es un 998877766554433331 , eso no es en lot. No me hagas intentar determinar lo que todo es simplemente por contexto.


organización

Esto significa definidamente que se divide en secciones más pequeñas. Usted está repitiendo una ton del código en bloques como este:

  note = Math.round(Math.log2(freq / 440) * 12); 2  

Extraiga la funcionalidad común en otro procedimiento, y luego llame a eso. Considere lo que sucedería si decide cambiar el formato: tendría que hacer cambios en 11 lugares diferentes. Si extrae eso en su propio procedimiento, debe cambiarlo exactamente en un lugar.


miscelanea

  • La primera línea de código en note = Math.round(Math.log2(freq / 440) * 12); 3 es básicamente una cláusula de guardia. Si se evalúa a note = Math.round(Math.log2(freq / 440) * 12); 4 , nada se ejecuta. Invierta la condición para dejarlo claro, eso es lo que es:

      note = Math.round(Math.log2(freq / 440) * 12); 5  
  • Utilice el Constante de VBA incorporado note = Math.round(Math.log2(freq / 440) * 12); 6 en lugar del note = Math.round(Math.log2(freq / 440) * 12); 7 . Es más fácil de leer, más fácil de buscar, y no requiere una asignación de memoria.

  • Considero note = Math.round(Math.log2(freq / 440) * 12); 8 para ser un error. Si está utilizando una variable para almacenar un número de fila, debe ser un 99887766655443339 . Puede desbordar un randomNotes0 con una llamada a randomNotes1 . Estos son básicamente tratados como randomNotes2 internamente, por lo que generalmente no hay mucha razón para usar randomNotes3 a menos que esté construyendo un randomNotes4 que necesita ser memoria alineado.

  • No use letras de columna. Excel los trata como números internamente, por lo que lo que sucede es que se convierte (o le pregunta a Excel para convertirlos) a una letra. Luego, construye una vanguardia fuera de la letra en formato A1 (la concatenación de cadena no es gratuita, y luego pasarla a Excel, que tiene que convertirla de nuevo en un número . Esto simplemente se desperdicia ciclos de CPU.

  • No está cambiando el randomNotes5 en cualquier lugar de este código. Si esto está destinado a ejecutarse en una hoja de trabajo activa, tome una referencia al principio y use eso. No debe arriesgarse a las ruedas que lo prohíban cambios de alguna manera, mientras que su código se está ejecutando.


Performance

Cálculo repetidamente que se garantiza que tienen el mismo resultado es simplemente el tiempo de CPU perdido. Por ejemplo, en este bloque de código ...

  randomNotes6  

... randomNotes7 va a ser exactamente iguales cada uno de los 3 veces lo llamas. Ya sea en caché, el resultado en una variable y use eso o envuélvalo en un bloque randomNotes8

  randomNotes9  

El const randomNotes= (() => { /* Create the objects needed to play a tone */ const audio = new AudioContext(); const volume = audio.createGain(); volume.gain.value = 0.5; volume.connect(audio.destination); /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/ const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4 const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300 /* Create and return the object that is the randomNote */ return { play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds const now = audio.currentTime; const oscillator = audio.createOscillator(); oscillator.type = "sine"; oscillator.connect(volume); oscillator.frequency.value = freq(randomNote()); oscillator.start(now + startIn); oscillator.stop(now + startIn + playFor); } }; })();0 y const randomNotes= (() => { /* Create the objects needed to play a tone */ const audio = new AudioContext(); const volume = audio.createGain(); volume.gain.value = 0.5; volume.connect(audio.destination); /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/ const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4 const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300 /* Create and return the object that is the randomNote */ return { play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds const now = audio.currentTime; const oscillator = audio.createOscillator(); oscillator.type = "sine"; oscillator.connect(volume); oscillator.frequency.value = freq(randomNote()); oscillator.start(now + startIn); oscillator.stop(now + startIn + playFor); } }; })();1 Las funciones están ridículamente lentamente dados los pequeños rangos que está buscando. Además de eso, nunca cambian . Usar una búsqueda en caché destruirá esto en el rendimiento. Construirías la búsqueda con una función algo así ...

  const randomNotes= (() => {          /* Create the objects needed to play a tone */     const audio = new AudioContext();     const volume = audio.createGain();      volume.gain.value = 0.5;     volume.connect(audio.destination);          /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/         const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4     const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor     const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300      /* Create and return the object that is the randomNote */         return {         play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds             const now = audio.currentTime;             const oscillator = audio.createOscillator();             oscillator.type = "sine";             oscillator.connect(volume);                         oscillator.frequency.value = freq(randomNote());             oscillator.start(now + startIn);               oscillator.stop(now + startIn + playFor);           }     }; })();2  

... e inicializarlo al inicio del procedimiento ...

  const randomNotes= (() => {          /* Create the objects needed to play a tone */     const audio = new AudioContext();     const volume = audio.createGain();      volume.gain.value = 0.5;     volume.connect(audio.destination);          /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/         const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4     const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor     const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300      /* Create and return the object that is the randomNote */         return {         play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds             const now = audio.currentTime;             const oscillator = audio.createOscillator();             oscillator.type = "sine";             oscillator.connect(volume);                         oscillator.frequency.value = freq(randomNote());             oscillator.start(now + startIn);               oscillator.stop(now + startIn + playFor);           }     }; })();3  

... luego use que para reemplazar su const randomNotes= (() => { /* Create the objects needed to play a tone */ const audio = new AudioContext(); const volume = audio.createGain(); volume.gain.value = 0.5; volume.connect(audio.destination); /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/ const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4 const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300 /* Create and return the object that is the randomNote */ return { play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds const now = audio.currentTime; const oscillator = audio.createOscillator(); oscillator.type = "sine"; oscillator.connect(volume); oscillator.frequency.value = freq(randomNote()); oscillator.start(now + startIn); oscillator.stop(now + startIn + playFor); } }; })();4 con una iteración simple de los resultados en caché para ese identificador. Este código ...

  const randomNotes= (() => {          /* Create the objects needed to play a tone */     const audio = new AudioContext();     const volume = audio.createGain();      volume.gain.value = 0.5;     volume.connect(audio.destination);          /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/         const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4     const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor     const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300      /* Create and return the object that is the randomNote */         return {         play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds             const now = audio.currentTime;             const oscillator = audio.createOscillator();             oscillator.type = "sine";             oscillator.connect(volume);                         oscillator.frequency.value = freq(randomNote());             oscillator.start(now + startIn);               oscillator.stop(now + startIn + playFor);           }     }; })();5  

... se convierte en esto:

  const randomNotes= (() => {          /* Create the objects needed to play a tone */     const audio = new AudioContext();     const volume = audio.createGain();      volume.gain.value = 0.5;     volume.connect(audio.destination);          /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/         const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4     const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor     const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300      /* Create and return the object that is the randomNote */         return {         play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds             const now = audio.currentTime;             const oscillator = audio.createOscillator();             oscillator.type = "sine";             oscillator.connect(volume);                         oscillator.frequency.value = freq(randomNote());             oscillator.start(now + startIn);               oscillator.stop(now + startIn + playFor);           }     }; })();6  

Dado el número de células que accedes, lo siguiente que haría sería sería recopilar todos los cambios de formato en una única unión de rangos, luego configure todo el formato en una operación. Esto evita que uno de los dos Redraws cada vez que configura una celda a cursiva.

  const randomNotes= (() => {          /* Create the objects needed to play a tone */     const audio = new AudioContext();     const volume = audio.createGain();      volume.gain.value = 0.5;     volume.connect(audio.destination);          /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/         const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4     const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor     const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300      /* Create and return the object that is the randomNote */         return {         play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds             const now = audio.currentTime;             const oscillator = audio.createOscillator();             oscillator.type = "sine";             oscillator.connect(volume);                         oscillator.frequency.value = freq(randomNote());             oscillator.start(now + startIn);               oscillator.stop(now + startIn + playFor);           }     }; })();7  

Luego, cuando identifique una célula que debe formatearse, puede hacer esto ...

  const randomNotes= (() => {          /* Create the objects needed to play a tone */     const audio = new AudioContext();     const volume = audio.createGain();      volume.gain.value = 0.5;     volume.connect(audio.destination);          /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/         const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4     const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor     const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300      /* Create and return the object that is the randomNote */         return {         play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds             const now = audio.currentTime;             const oscillator = audio.createOscillator();             oscillator.type = "sine";             oscillator.connect(volume);                         oscillator.frequency.value = freq(randomNote());             oscillator.start(now + startIn);               oscillator.stop(now + startIn + playFor);           }     }; })();8  

... y formatear todo el lío en un solo disparo:

  const randomNotes= (() => {          /* Create the objects needed to play a tone */     const audio = new AudioContext();     const volume = audio.createGain();      volume.gain.value = 0.5;     volume.connect(audio.destination);          /* Function to calculate frequency of a note starting at A4 and stepping semi tones*/         const freq = note => 2 ** (note / 12) * 440; // 440 is the frequency of A4     const randomNote = () => notes[Math.random() * notes.length | 0]; // the bitwise Or does the same as Math.floor     const notes = [-25, -2, 22, 46]; // Close to your 100, 400, 1600 and 6300      /* Create and return the object that is the randomNote */         return {         play(startIn = 1, playFor = 4) { // startIn and playFor is time in seconds             const now = audio.currentTime;             const oscillator = audio.createOscillator();             oscillator.type = "sine";             oscillator.connect(volume);                         oscillator.frequency.value = freq(randomNote());             oscillator.start(now + startIn);               oscillator.stop(now + startIn + playFor);           }     }; })();9  

Finalmente, ahora que ha convertido su dirección A1 a la columna Row , se vuelve bastante trivial para cambiar al procesamiento de matriz en lugar de establecer valores de celdas individuales. Dale la longitud actual de la respuesta, lo dejaré como un ejercicio para el lector (u otro crítico). Incluso Sin Procesamiento de matriz, las sugerencias mencionadas anteriormente deben ser una gran victoria de rendimiento, que solo sería helado en el pastel ...

 

General Observations


Indentation

The first thing that I did when I loaded your code up in the VBE was to run an indenter on it. Without consistent indentation of logical blocks of code (If statements, For Each bodies, etc.), it is incredibly difficult to get a handle on what the code is doing. Especially if your Sub is 201 lines long.


Case Syntax

Using Case Is = "whatever" is completely redundant. Case "whatever" is equivalent, easier to read, and saves a boolean expression evaluation. Also, having an empty Case Else is not necessary - it doesn't execute any code, so it simply constitutes noise while reading the Select block.


Variable Declarations

Put these immediately before thier usage. Having to continually scroll up to the top of the Sub to see how they are defined is tedious. They'll operate exactly the same way and will be much more readable.

Also, the line Dim p, s, poste, x As Variant isn't doing what you think it is doing. Only x is explicitly declared as Variant. The others are implicitly Variant. But there isn't any reason for any of these not to be strongly typed. While it isn't a major performance implication, it does require run-time coercion in most of the places where you use them.

Finally, give your variables meaningful names. If I'm staring at a 201 line procedure and the only information I have (after scrolling all the way to the top) about p is that it's a Variant, that's not at lot. Don't make me try to determine what everything is simply by context.


Organization

This definiately needs to be split up into smaller sections. You are repeating a ton of code in blocks like this:

Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Aprxc3xa8s-midi", Lookat:=xlWhole) If Not x Is Nothing Then     Do         If ActiveSheet.Range(Col & x.Row) = "" Then             ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value             ActiveSheet.Range(Col & x.Row).Font.Italic = True         End If         Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)     Loop While Not x Is Nothing End If 

Extract the common functionality into another procedure, and then call that. Consider what would happen if you decide to change the formatting - you'd need to make changes in 11 different places. If you extract that out into its own procedure, you have to change it in exactly one place.


Miscellanea

  • The first line of code in DraftFromCycle is basically a guard clause. If it evaluates to False, nothing executes. I'd invert the condition to make it clear that's what it is:

    If Application.WorksheetFunction.CountA(Range(PlanningAgentEmptyRange)) <> 0 Then     Exit Sub End If 
  • Use the built in VBA constant vbNullString instead of the literal "". It's easier to read, easier to search for, and doesn't require a memory allocation.

  • I consider Dim Cycle_lastrow As Integer to be an error. If you're using a variable to store a row number, then it should be a Long. You can overflow an Integer with a call to .Row. These are basically treated as Long internally, so there's generally not much reason to use Integer unless you're building a Type that needs to be memory aligned.

  • Don't use column letters. Excel treats them as numbers internally, so what happens is that you convert (or ask Excel to convert) them to a letter. Then you build a range out of the letter in A1 format (string concatenation isn't free either), then pass it to Excel, which has to convert it back into a number. This is simply wasted CPU cycles.

  • You aren't changing the ActiveSheet anywhere in this code. If this is intended to run on a the active worksheet, grab a reference at the start and use that. You shouldn't risk the wheels coming off it it somehow changes while your code is running.


Performance

Repeatedly calculating things that are guaranteed to have the same result is simply wasted CPU time. For example, in this block of code...

Do     If ActiveSheet.Range(Col & x.Row) = "" Then         ActiveSheet.Range(Col & x.Row) = Worksheets("Cycle").Range("A" & poste.Row).Value         ActiveSheet.Range(Col & x.Row).Font.Italic = True     End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x) Loop While Not x Is Nothing 

... ActiveSheet.Range(Col & x.Row) is going to be exactly the same each of the 3 times you call it. Either cache the result in a variable and use that or wrap it in a With block:

With ActiveSheet.Range(Col & x.Row)     If .Value = vbNullString Then         .Value = Worksheets("Cycle").Cells(poste.Row, 1).Value         .Font.Italic = True     End If     Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x) End With 

The Range.Find and Range.FindNext functions are ridiculously slow given the tiny ranges that you're searching in. On top of that, they never change. Using a cached lookup will destroy this in performance. You would build the lookup with a function something like this...

'Add a reference to Microsoft Scripting Runtime. 'Build a lookup keyed by a string identifier, with values containing a Collection of cells Private Function GetLookupForRange(source As Range) As Scripting.Dictionary     Dim lookup As Scripting.Dictionary     Set lookup = New Scripting.Dictionary      Dim currentCell As Range     For Each currentCell In source         Dim identifier As String         identifier = currentCell.Value         Dim results As Collection         If Not lookup.Exists(identifier) Then             Set results = New Collection             lookup.Add identifier, results         Else             Set results = lookup.Item(identifier)         End If         results.Add currentCell     Next      Set GetLookupForRange = lookup End Function 

...and initialize it at the start of the procedure...

Dim targetSheet As Worksheet Set targetSheet = ActiveSheet  Dim weekdayLookup As Scripting.Dictionary Set weekdayLookup = GetLookupForRange(targetSheet.Range(PosteWeekDayRange)) 

...then use that to replace your .Find with a simple iteration of the cached results for that identifier. This code...

Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Aprxc3xa8s-midi", Lookat:=xlWhole) If Not x Is Nothing Then     Do         With ActiveSheet.Range(Col & x.Row)             If .Value = vbNullString Then                 .Value = Worksheets("Cycle").Cells(poste.Row, 1).Value                 .Font.Italic = True             End If             Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)         End With     Loop While Not x Is Nothing End If 

...becomes this:

'I should be extracted as a function! If weekdayLookup.Exists("Aprxc3xa8s-midi") Then     'The first "found" item is the first Collection member.     Dim results As Collection     Set results = weekdayLookup.Item("Aprxc3xa8s-midi")     Dim currentResult As Range     'You can now simply loop through the cached results.     For Each currentResult In results         Dim targetCell As Range         'Col should be a number, remember?         Set targetCell = targetSheet.Cells(currentResult.Row, Col)         With targetCell             If .Value = vbNullString Then                 .Value = Worksheets("Cycle").Cells(poste.Row, 1).Value                 .Font.Italic = True             End If         End With     Next End If 

Given the number of cells that you're accessing, the next thing I would do would be to collect all of the formatting changes into a single union of ranges - then set all of the formatting in one operation. This prevents one of the two redraws every time you set a cell to italic.

'At the top. Dim italicized As Range 

Then when you identify a cell that needs to be formatted, you can do this...

If .Value = vbNullString Then     .Value = Worksheets("Cycle").Cells(poste.Row, 1).Value     If italicized Is Nothing Then         Set italicized = targetCell     Else         Application.Union italicized, targetCell     End If End If     

...and format the whole mess in one shot:

'At the very bottom. italicized.Font.Italic = True 

Finally, now that you've converted your A1 addressing to Row\Column, it becomes fairly trivial to switch to array processing as opposed to setting values of individual cells. Give the current length of the answer, I'll leave that as an exercise for the reader (or another reviewer). Even without array processing, the suggestions noted above should be a huge performance win - that would just be icing on the cake...

 
 
0
 
vote

indentación

Intenté hacerlo manualmente, no sabía que podría haber sido automatizado. He descargado un complemento y sí, es mucho mejor


sintaxis de casos

Se han realizado el cambio


Declaraciones variables

He cambiado el nombre de la variable para ser más significativo. La declaración se fija.


organización

El código es mucho más legible con el bloque en otro Sub.


misceláneo

Se han realizado cambios propuestos, el código se ve más y más limpio.


rendimiento

He almacenado en caché el rango en una variable y reemplazó la letra COL por número de COL.

Con todas estas modificaciones cuando agregué EnableEvent = False funcionó (no antes) y bueno, es instantáneo.

Pequeños hipo con la función de búsqueda (que no estoy entendiendo del todo) El código Tome el nombre de la misma persona y ponlo varias veces en el horario semanal.

Editar: Añadido como una variable pequeña para evitar duplicar y está funcionando bien

Y todavía no lo administré en cursiva, pero busco subir y correr.


Código actualizado

   Option Explicit  Public Const PlanningAgentEmptyRange         As String = "C12:G58,F74:G78" 'Range agent present Public Const PosteWeekDayRange               As String = "B12:B72" 'Range agent present Public Const PosteWeekEndRange               As String = "B73:B78" 'Range agent present  Dim cel As Variant Dim Col As Variant 'Column  Sub DraftFromCycle()      With Application         .ScreenUpdating = False         .EnableEvents = False     End With      If Application.WorksheetFunction.CountA(Range(PlanningAgentEmptyRange)) <> 0 Then         Exit Sub     End If      'Loop through the 5 day of the week     For Col = 3 To 7          Dim DayDateActiveSheet As Range ' Date 01/01/2001 of the Column         Set DayDateActiveSheet = ActiveSheet.Cells(11, Col)          Dim FindDayDateCycle As Variant         Set FindDayDateCycle = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDateActiveSheet, Lookat:=xlWhole)         If Not FindDayDateCycle Is Nothing Then              With Worksheets("Cycle")                 Dim DayRangeCycle As Range                 Set DayRangeCycle = .Range(.Cells(6, FindDayDateCycle.Column), .Cells(LastRow(Feuil55), FindDayDateCycle.Column))             End With              For Each cel In DayRangeCycle                 Select Case cel                     Case "AM"                         Call RepeatWeekDay("Après-midi")                      Case "N"                         Call RepeatWeekDay("Nuit")                      Case "R N"                         Call RepeatWeekDay("Récup Nuit")                      Case "R Av"                         Call RepeatWeekDay("R.H. Avant Garde")                      Case "R Ap"                         Call RepeatWeekDay("R.H. Après Garde")                      Case "RTP"                         Call RepeatWeekDay("R.T.P.")                      Case "TC"                         Call RepeatWeekDay("T.C.")                      Case "BM"                         Call RepeatWeekDay("Biomol")                      Case "CMF"                         Call RepeatWeekDay("C.M.F.")                      Case Is = "URC"                         Call RepeatWeekDay("U.R.C.")                  End Select              Next cel         End If      Next Col      'Loop col du Week End     For Col = 6 To 7          Set DayDateActiveSheet = ActiveSheet.Cells(73, Col)         Set FindDayDateCycle = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDateActiveSheet, Lookat:=xlWhole)         If Not FindDayDateCycle Is Nothing Then              With Worksheets("Cycle")                 Set DayRangeCycle = .Range(.Cells(6, FindDayDateCycle.Column), .Cells(LastRow(Feuil55), FindDayDateCycle.Column))             End With              For Each cel In DayRangeCycle                  Select Case cel                     Case "AM"                         Call RepeatWeekEnd("Après-midi")                      Case "N"                         Call RepeatWeekEnd("Nuit")                      Case "6h25"                         Call RepeatWeekEnd("6h25 - 13h25")                      Case Is = "7h30"                         Call RepeatWeekEnd("7h30 - 14h30")                      Case "7h45"                         Call RepeatWeekEnd("7h45 - 14h45")                   End Select              Next cel         End If     Next Col      With Application         .ScreenUpdating = True         .EnableEvents = True     End With   End Sub  Sub RepeatWeekDay(FindPoste As String)     'Public Const PosteWeekDayRange               As String = "B12:B72" 'Range agent present     'Public Const PosteWeekEndRange               As String = "B73:B78" 'Range agent present      Dim targetSheet As Worksheet     Set targetSheet = ActiveSheet      Dim weekdayLookup As Scripting.Dictionary     Set weekdayLookup = GetLookupForRange(targetSheet.Range(PosteWeekDayRange))      If weekdayLookup.Exists(FindPoste) Then         'The first "found" item is the first Collection member.         Dim results As Collection         Set results = weekdayLookup.Item(FindPoste)         Dim currentResult As Range         'You can now simply loop through the cached results.         For Each currentResult In results             Dim targetCell As Range             'Col should be a number, remember?             Set targetCell = targetSheet.Cells(currentResult.Row, Col)             With targetCell                 Dim previousrow As Long                 If previousrow <> cel.Row Then                 If .Value = vbNullString Then                     .Value = Worksheets("Cycle").Cells(cel.Row, 1).Value                     .Font.Italic = True                     previousrow = cel.Row                 End If                 End If              End With         Next     End If  End Sub  Sub RepeatWeekEnd(FindPoste As String)       Dim targetSheet As Worksheet     Set targetSheet = ActiveSheet      Dim weekdayLookup As Scripting.Dictionary     Set weekdayLookup = GetLookupForRange(targetSheet.Range(PosteWeekEndRange))      If weekdayLookup.Exists(FindPoste) Then         'The first "found" item is the first Collection member.         Dim results As Collection         Set results = weekdayLookup.Item(FindPoste)         Dim currentResult As Range         'You can now simply loop through the cached results.         For Each currentResult In results             Dim targetCell As Range             'Col should be a number, remember?             Set targetCell = targetSheet.Cells(currentResult.Row, Col)             With targetCell                 Dim previousrow As Long                 If previousrow <> cel.Row Then                 If .Value = vbNullString Then                     .Value = Worksheets("Cycle").Cells(cel.Row, 1).Value                     .Font.Italic = True                     previousrow = cel.Row                 End If                 End If              End With         Next     End If     End Sub  'Add a reference to Microsoft Scripting Runtime. 'Build a lookup keyed by a string identifier, with values containing a Collection of cells Private Function GetLookupForRange(source As Range) As Scripting.Dictionary     Dim lookup As Scripting.Dictionary     Set lookup = New Scripting.Dictionary      Dim currentCell As Range     For Each currentCell In source         Dim identifier As String         identifier = currentCell.Value         Dim results As Collection         If Not lookup.Exists(identifier) Then             Set results = New Collection             lookup.Add identifier, results         Else             Set results = lookup.Item(identifier)         End If         results.Add currentCell     Next      Set GetLookupForRange = lookup End Function   
 

Indentation

I tried to do it manually, i didn't know that it could have been automated. I've downloaded an Add-on and yes it's much better


Case Syntax

The change have been made


Variable Declarations

I've changed the name of the variable to be more meaningful. The declaration are fixed.


Organization

The code is much more readable with the block in another Sub.


Miscellaneous

Proposed changes have been made, the code is looking more and cleaner.


Performance

I've cached the range in a variable and replaced col letter by col number.

With all of these modification when I added EnableEvent = False it worked (it didn't before) and well it's instantaneous.

Small hiccups with the lookup function (that I'm not quite understanding) the code take the name of the same person and put it multiple time in the Weekly schedule.

EDIT: I added as small variable to prevent duplicate and it is working fine

And I didn't quite yet manage the italicized but I looking to get it up and running.


Updated code

 Option Explicit  Public Const PlanningAgentEmptyRange         As String = "C12:G58,F74:G78" 'Range agent present Public Const PosteWeekDayRange               As String = "B12:B72" 'Range agent present Public Const PosteWeekEndRange               As String = "B73:B78" 'Range agent present  Dim cel As Variant Dim Col As Variant 'Column  Sub DraftFromCycle()      With Application         .ScreenUpdating = False         .EnableEvents = False     End With      If Application.WorksheetFunction.CountA(Range(PlanningAgentEmptyRange)) <> 0 Then         Exit Sub     End If      'Loop through the 5 day of the week     For Col = 3 To 7          Dim DayDateActiveSheet As Range ' Date 01/01/2001 of the Column         Set DayDateActiveSheet = ActiveSheet.Cells(11, Col)          Dim FindDayDateCycle As Variant         Set FindDayDateCycle = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDateActiveSheet, Lookat:=xlWhole)         If Not FindDayDateCycle Is Nothing Then              With Worksheets("Cycle")                 Dim DayRangeCycle As Range                 Set DayRangeCycle = .Range(.Cells(6, FindDayDateCycle.Column), .Cells(LastRow(Feuil55), FindDayDateCycle.Column))             End With              For Each cel In DayRangeCycle                 Select Case cel                     Case "AM"                         Call RepeatWeekDay("Aprxc3xa8s-midi")                      Case "N"                         Call RepeatWeekDay("Nuit")                      Case "R N"                         Call RepeatWeekDay("Rxc3xa9cup Nuit")                      Case "R Av"                         Call RepeatWeekDay("R.H. Avant Garde")                      Case "R Ap"                         Call RepeatWeekDay("R.H. Aprxc3xa8s Garde")                      Case "RTP"                         Call RepeatWeekDay("R.T.P.")                      Case "TC"                         Call RepeatWeekDay("T.C.")                      Case "BM"                         Call RepeatWeekDay("Biomol")                      Case "CMF"                         Call RepeatWeekDay("C.M.F.")                      Case Is = "URC"                         Call RepeatWeekDay("U.R.C.")                  End Select              Next cel         End If      Next Col      'Loop col du Week End     For Col = 6 To 7          Set DayDateActiveSheet = ActiveSheet.Cells(73, Col)         Set FindDayDateCycle = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDateActiveSheet, Lookat:=xlWhole)         If Not FindDayDateCycle Is Nothing Then              With Worksheets("Cycle")                 Set DayRangeCycle = .Range(.Cells(6, FindDayDateCycle.Column), .Cells(LastRow(Feuil55), FindDayDateCycle.Column))             End With              For Each cel In DayRangeCycle                  Select Case cel                     Case "AM"                         Call RepeatWeekEnd("Aprxc3xa8s-midi")                      Case "N"                         Call RepeatWeekEnd("Nuit")                      Case "6h25"                         Call RepeatWeekEnd("6h25 - 13h25")                      Case Is = "7h30"                         Call RepeatWeekEnd("7h30 - 14h30")                      Case "7h45"                         Call RepeatWeekEnd("7h45 - 14h45")                   End Select              Next cel         End If     Next Col      With Application         .ScreenUpdating = True         .EnableEvents = True     End With   End Sub  Sub RepeatWeekDay(FindPoste As String)     'Public Const PosteWeekDayRange               As String = "B12:B72" 'Range agent present     'Public Const PosteWeekEndRange               As String = "B73:B78" 'Range agent present      Dim targetSheet As Worksheet     Set targetSheet = ActiveSheet      Dim weekdayLookup As Scripting.Dictionary     Set weekdayLookup = GetLookupForRange(targetSheet.Range(PosteWeekDayRange))      If weekdayLookup.Exists(FindPoste) Then         'The first "found" item is the first Collection member.         Dim results As Collection         Set results = weekdayLookup.Item(FindPoste)         Dim currentResult As Range         'You can now simply loop through the cached results.         For Each currentResult In results             Dim targetCell As Range             'Col should be a number, remember?             Set targetCell = targetSheet.Cells(currentResult.Row, Col)             With targetCell                 Dim previousrow As Long                 If previousrow <> cel.Row Then                 If .Value = vbNullString Then                     .Value = Worksheets("Cycle").Cells(cel.Row, 1).Value                     .Font.Italic = True                     previousrow = cel.Row                 End If                 End If              End With         Next     End If  End Sub  Sub RepeatWeekEnd(FindPoste As String)       Dim targetSheet As Worksheet     Set targetSheet = ActiveSheet      Dim weekdayLookup As Scripting.Dictionary     Set weekdayLookup = GetLookupForRange(targetSheet.Range(PosteWeekEndRange))      If weekdayLookup.Exists(FindPoste) Then         'The first "found" item is the first Collection member.         Dim results As Collection         Set results = weekdayLookup.Item(FindPoste)         Dim currentResult As Range         'You can now simply loop through the cached results.         For Each currentResult In results             Dim targetCell As Range             'Col should be a number, remember?             Set targetCell = targetSheet.Cells(currentResult.Row, Col)             With targetCell                 Dim previousrow As Long                 If previousrow <> cel.Row Then                 If .Value = vbNullString Then                     .Value = Worksheets("Cycle").Cells(cel.Row, 1).Value                     .Font.Italic = True                     previousrow = cel.Row                 End If                 End If              End With         Next     End If     End Sub  'Add a reference to Microsoft Scripting Runtime. 'Build a lookup keyed by a string identifier, with values containing a Collection of cells Private Function GetLookupForRange(source As Range) As Scripting.Dictionary     Dim lookup As Scripting.Dictionary     Set lookup = New Scripting.Dictionary      Dim currentCell As Range     For Each currentCell In source         Dim identifier As String         identifier = currentCell.Value         Dim results As Collection         If Not lookup.Exists(identifier) Then             Set results = New Collection             lookup.Add identifier, results         Else             Set results = lookup.Item(identifier)         End If         results.Add currentCell     Next      Set GetLookupForRange = lookup End Function 
 
 
         
         

Relacionados problema

2  Búsqueda de pruebas de abstracción y unidad en mesa Excel  ( Abstracting and unit testing lookups in excel table ) 
Fondo Tengo una solución de VBA que utilizo para ingerir informes de texto de inversión y reformatearlos para su análisis en Excel. Funciona, pero las macro...

5  Excel a JSON Parser con http descargar  ( Excel to json parser with http download ) 
He estado trabajando en un proyecto ( enlace ) a Descargue una hoja de cálculo de Ransomware y propiedades conocidas y conviértase en JSON para que pueda cons...

6  Fijación de archivos de reclamación médica a través del archivo de texto Lea / escribe  ( Fixing medical claim files through text file read write ) 
Con Gracias a @ Mat'Smug y @comintern por su aliento, aquí hay un programa que escribí para ayudar a mi equipo a reparar archivos de reclamación médica. El ...

3  Coloque el cálculo del costo del campamento de verano utilizando las hojas de Google  ( Summer camp cost calculation using google sheets ) 
Estoy haciendo una hoja que suma el costo total para un campamento de verano después del registro. Cada padre puede registrarse hasta cinco niños. Ya he hecho...

5  Copiando datos de libros cerrados  ( Copying data from closed workbooks ) 
Soy un pasante en una empresa industrial en Brasil y sucede que estoy usando mucho en Excel. Acabo de empezar a jugar con VBA hace un par de días, ¡y me divie...

6  Crear tabla que enumera la visibilidad de la hoja de trabajo  ( Create table that lists worksheet visibility ) 
Siguiendo mi pregunta anterior crear Una tabla que enumera las macros en un libro de trabajo o hoja de trabajo Aquí está mi Sub para determinar la visibilid...

6  Juego de serpientes - Dentro de la hoja de trabajo - Celdas como píxeles  ( Snake game within worksheet cells as pixels ) 
Desde mi intento bastante mediocre de hacer un juego de invasores del espacio, me topé con un caché de juegos de Visual Basic para solicitar juegos escritos p...

7  Recuperando datos de archivos en la carpeta  ( Retrieving data from files in the folder ) 
Estoy a usar el código VBA para simplemente recuperar ciertos datos de todos los archivos de Excel en cierta carpeta y pegarlo en la hoja de cálculo de trabaj...

3  Comparando células de dos hojas de trabajo  ( Comparing cells of two worksheets ) 
Con el siguiente código, trato de comparar el contenido de dos hojas de trabajo. La primera columna contiene una clave que es única y las siguientes columnas ...

2  Importando datos en Excel  ( Importing data into excel ) 
¿Existe una forma más fácil de importar datos en una matriz de Excel u otra estructura de datos? He intentado investigar colecciones, pero he encontrado la D...




© 2022 respuesta.top Reservados todos los derechos. Centro de preguntas y respuestas reservados todos los derechos