Barra de Progreso según Información
A los miembros de esté foro, en esta ocasión recurro a Uds, para que brinden su apoyo en un contador que vaya en el Workbook_Open, en donde se cuente la cantidad de registros que sería a partir de la B8 hasta el final (en este caso tiene 181 registro o podría ser) y que al presionar el boton de Fusionar Consolidado con la macro que indico, se procese los registros como indica en la Imagen 1 y al culminar dicha fusión, se muestre el mensaje como la Imagen 2.
Sub FusionarRetribuciones(): On Error Resume Next
Dim Documento As String, Fila As Long
Hoja3.Range("A8").Resize(Hoja3.Range("B" & Rows.Count).End(xlUp).Row + 2, 43).Clear
Application.ScreenUpdating = False
Fila = 7
For x = 8 To Hoja1.Range("B" & Rows.Count).End(xlUp).Row
If CStr(Hoja1.Range("B" & x)) <> Documento Then
Fila = Fila + 1
Hoja1.Rows(x).Copy Hoja3.Rows(Fila)
Documento = Hoja1.Range("B" & x)
Else
If Hoja1.Range("D" & x) < Hoja3.Range("D" & Fila) Then
Hoja3.Range("D" & Fila) = Hoja1.Range("D" & x)
End If
If Hoja1.Range("E" & x) > Hoja3.Range("E" & Fila) Then
Hoja3.Range("E" & Fila) = Hoja1.Range("E" & x)
End If
For y = 6 To 43
Hoja3.Cells(Fila, y) = Hoja3.Cells(Fila, y) + Hoja1.Cells(x, y)
If Hoja3.Cells(Fila, y) = 0 Then Hoja3.Cells(Fila, y) = ""
Next
End If
Next
Hoja1.Rows(x).Copy Hoja3.Rows(Fila + 1)
For y = 11 To 42
Hoja3.Cells(Fila + 1, y).FormulaR1C1 = "=SUM(R[-" & Fila - 7 & "]C:R[-1]C)"
Next
Hoja3.Cells(Fila + 1, 35) = ""Application.Speech.Speak "Consolidado terminado"
MsgBox ("Consolidado terminado"), , "AVISO"
Range("A4").SelectEnd Sub
Imagen 1.
Imagen 2
Como siempre agradeciendo a los miembros de este foro, ante su apoyo brindado.
1 respuesta
Te anexo la macro actualizada
Sub FusionarRetribuciones(): On Error Resume Next
Dim Documento As String, Fila As Long
Dim u
'
Application.ScreenUpdating = False
Application.StatusBar = False
'
reg = Hoja1.Range("B" & Rows.Count).End(xlUp).Row - 7
Hoja3.Range("A8").Resize(Hoja3.Range("B" & Rows.Count).End(xlUp).Row + 2, 43).Clear
Fila = 7
For x = 8 To Hoja1.Range("B" & Rows.Count).End(xlUp).Row
Application.StatusBar = "Consultando ... " & x - 7 & " de " & reg & " - El proceso aún no termina."
If CStr(Hoja1.Range("B" & x)) <> Documento Then
Fila = Fila + 1
Hoja1.Rows(x).Copy Hoja3.Rows(Fila)
Documento = Hoja1.Range("B" & x)
Else
If Hoja1.Range("D" & x) < Hoja3.Range("D" & Fila) Then
Hoja3.Range("D" & Fila) = Hoja1.Range("D" & x)
End If
If Hoja1.Range("E" & x) > Hoja3.Range("E" & Fila) Then
Hoja3.Range("E" & Fila) = Hoja1.Range("E" & x)
End If
For y = 6 To 43
Hoja3.Cells(Fila, y) = Hoja3.Cells(Fila, y) + Hoja1.Cells(x, y)
If Hoja3.Cells(Fila, y) = 0 Then Hoja3.Cells(Fila, y) = ""
Next
End If
Next
Hoja1.Rows(x).Copy Hoja3.Rows(Fila + 1)
For y = 11 To 42
Hoja3.Cells(Fila + 1, y).FormulaR1C1 = "=SUM(R[-" & Fila - 7 & "]C:R[-1]C)"
Next
Hoja3.Cells(Fila + 1, 35) = ""
'
Application.StatusBar = "Se realizaron todas las consultas."
Application.Speech.Speak "Consolidado terminado"
MsgBox ("Consolidado terminado"), , "AVISO"
Range("A4").Select
Application.StatusBar = False
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Buenas noches amigo Dante, siempre apoyándome en cada cosa que requiero para facilitar y ahorrar tiempo, ya que ahora los consolidados que realizado ha aumentado su volumen de información, mi pregunta es a esta macro que haz modificado, sera posible agregar una rutina que indique el porcentaje de avance de acuerdo a la correlación del numero. Desde ya agradezco tu apoyo en caso de que se pueda dicha rutina.
{"Lat":-8.22090052638057,"Lng":-78.9777206559585}
¿Quieres qué el porcentaje de avance aparezca en la misma línea?
Con mucho gusto te ayudo con todas tus peticiones.
Valora esta respuesta y crea una nueva pregunta
Ahí me describes con detalle lo que necesitas.
Sal u dos
