Modificar comentarios de un rango de celdas al modificar una celda dentro de ese rango, evitando filas que no tengan comentarios
Tengo el siguiente ejercicio:
Estoy implementando un formato para almacén que revise las entradas, salidas diarias y totales mensuales.
En el ejemplo que les muestro tengo un rango de captura de D5:I15 y CASI todas las celdas dentro de ese rango tienen comentarios pero como se puede ver en la imagen en la fila 10 esta un encabezado de "PLASTICOS" dicha fila no tiene comentarios ya que es un encabezado y puede cambiar de posición al ocuparse insertar mas filas previas, asi que puede ser la 10, 11, 12, etc...
Los comentarios los tengo para que en cada celda me muestre un subtotal de la cantidad de artículos que han entrado y salido del almacén hasta ese momento (ver imagen adjunta celda F5 el subtotal hasta ese momento es 31)
La cuestión es que el código que tengo no me funciona si tengo como en este caso filas intermedias de encabezados, las cuales obviamente no llevan ningún comentario.
Para intentar ser mas claro comparto el código y una pantalla de mi ejemplo.
Lo que ocupo es que el código ignore las filas que no tengan comentarios dentro del rango o las celdas dentro del rango que no tengan comentarios.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) For fila = 5 To 15 E1 = Cells(fila, 3) + Cells(fila, 4) S1 = E1 - Cells(fila, 5) E2 = S1 + Cells(fila, 6) S2 = E2 - Cells(fila, 7) E3 = S2 + Cells(fila, 8) S3 = E3 - Cells(fila, 9) 'Las Variables "E" se refieren a las entradas de almacen 'Las Variables "S" se refieren a las salidas de almacen Cells(fila, 4).Comment.Text Text:="Inventario: " & E1 & Chr(10) Cells(fila, 5).Comment.Text Text:="Inventario: " & S1 & Chr(10) Cells(fila, 6).Comment.Text Text:="Inventario: " & E2 & Chr(10) Cells(fila, 7).Comment.Text Text:="Inventario: " & S2 & Chr(10) Cells(fila, 8).Comment.Text Text:="Inventario: " & E3 & Chr(10) Cells(fila, 9).Comment.Text Text:="Inventario: " & S3 & Chr(10) Next fila End Sub
1 Respuesta
Te anexo la macro actualizada
Private Sub Worksheet_Change(ByVal Target As Range) For fila = 5 To 15 If Cells(fila, 3) <> "" Then E1 = Cells(fila, 3) + Cells(fila, 4) S1 = E1 - Cells(fila, 5) E2 = S1 + Cells(fila, 6) S2 = E2 - Cells(fila, 7) E3 = S2 + Cells(fila, 8) S3 = E3 - Cells(fila, 9) 'Las Variables "E" se refieren a las entradas de almacen 'Las Variables "S" se refieren a las salidas de almacen On Error Resume Next For j = 4 To 9 Cells(fila, j).ClearComments Next On Error GoTo 0 Cells(fila, 4).AddComment Cells(fila, 4).Comment.Text Text:="Inventario: " & E1 & Chr(10) Cells(fila, 5).AddComment Cells(fila, 5).Comment.Text Text:="Inventario: " & S1 & Chr(10) Cells(fila, 6).AddComment Cells(fila, 6).Comment.Text Text:="Inventario: " & E2 & Chr(10) Cells(fila, 7).AddComment Cells(fila, 7).Comment.Text Text:="Inventario: " & S2 & Chr(10) Cells(fila, 8).AddComment Cells(fila, 8).Comment.Text Text:="Inventario: " & E3 & Chr(10) Cells(fila, 9).AddComment Cells(fila, 9).Comment.Text Text:="Inventario: " & S3 & Chr(10) End If Next fila End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Funcionando muy bien Dante gracias, lo único que veo es que como quita y agrega comentarios los agrega con el formato por default, hay forma (instrucción) para que formatee los comentarios en color de fondo, transparencia, ¿y formato de fuente?.
Saludos
Te anexo la macro actualizada, si ya existe un comentario, respetará el formato, si no existe, entonces te creará un comentario, pero deberás cambiar las propiedades la primera vez.
Private Sub Worksheet_Change(ByVal Target As Range) For fila = 5 To 15 If Cells(fila, 3) <> "" Then E1 = Cells(fila, 3) + Cells(fila, 4) S1 = E1 - Cells(fila, 5) E2 = S1 + Cells(fila, 6) S2 = E2 - Cells(fila, 7) E3 = S2 + Cells(fila, 8) S3 = E3 - Cells(fila, 9) 'Las Variables "E" se refieren a las entradas de almacen 'Las Variables "S" se refieren a las salidas de almacen If Cells(fila, 4).Comment Is Nothing Then Cells(fila, 4).AddComment Else Cells(fila, 4).Comment.Text Text:="Inventario: " & E1 & Chr(10) End If If Cells(fila, 5).Comment Is Nothing Then Cells(fila, 5).AddComment Else Cells(fila, 5).Comment.Text Text:="Inventario: " & S1 & Chr(10) End If If Cells(fila, 6).Comment Is Nothing Then Cells(fila, 6).AddComment Else Cells(fila, 6).Comment.Text Text:="Inventario: " & E2 & Chr(10) End If If Cells(fila, 7).Comment Is Nothing Then Cells(fila, 7).AddComment Else Cells(fila, 7).Comment.Text Text:="Inventario: " & S2 & Chr(10) End If If Cells(fila, 8).Comment Is Nothing Then Cells(fila, 8).AddComment Else Cells(fila, 8).Comment.Text Text:="Inventario: " & E3 & Chr(10) End If If Cells(fila, 9).Comment Is Nothing Then Cells(fila, 9).AddComment Else Cells(fila, 9).Comment.Text Text:="Inventario: " & S3 & Chr(10) End If End If Next fila End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Te anexo otra actualización
Private Sub Worksheet_Change(ByVal Target As Range) For fila = 5 To 15 If Cells(fila, 3) <> "" Then E1 = Cells(fila, 3) + Cells(fila, 4) S1 = E1 - Cells(fila, 5) E2 = S1 + Cells(fila, 6) S2 = E2 - Cells(fila, 7) E3 = S2 + Cells(fila, 8) S3 = E3 - Cells(fila, 9) 'Las Variables "E" se refieren a las entradas de almacen 'Las Variables "S" se refieren a las salidas de almacen If Cells(fila, 4).Comment Is Nothing Then Cells(fila, 4).AddComment End If Cells(fila, 4).Comment.Text Text:="Inventario: " & E1 & Chr(10) If Cells(fila, 5).Comment Is Nothing Then Cells(fila, 5).AddComment End If Cells(fila, 5).Comment.Text Text:="Inventario: " & S1 & Chr(10) If Cells(fila, 6).Comment Is Nothing Then Cells(fila, 6).AddComment End If Cells(fila, 6).Comment.Text Text:="Inventario: " & E2 & Chr(10) If Cells(fila, 7).Comment Is Nothing Then Cells(fila, 7).AddComment End If Cells(fila, 7).Comment.Text Text:="Inventario: " & S2 & Chr(10) If Cells(fila, 8).Comment Is Nothing Then Cells(fila, 8).AddComment End If Cells(fila, 8).Comment.Text Text:="Inventario: " & E3 & Chr(10) If Cells(fila, 9).Comment Is Nothing Then Cells(fila, 9).AddComment End If Cells(fila, 9).Comment.Text Text:="Inventario: " & S3 & Chr(10) End If Next fila End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
