Almacenar como comentarios los datos de una columna determinada en las celdas de una columna seleccionable

[El Perro Juhh]

Hola a todos, me gustaría pedir ayuda con la siguiente macro.

Adjunto hoja con datos relativos a lecturas de contadores de consumos, con dos pestañas: CONTROL y PARQUE

En PARQUE están los datos. Decir que la tabla real sobre la que se ejecutará la macro tiene ahora mismo unos 17.200 registros

En cada registro de la tabla se guarda un numero de ordenacion, numero de contrato, nombre y direccion, y despues relativo a cada trimestre de lectura del contador hay FECXXXX que es la fecha de lectura de un contador, LECXXXX que es la lectura que tiene el contador en un periodo determinado. En el campo INCIDENCIA se guardan las incidencias del periodo actual.

En CONTROL hay un botón que abre un formulario desde el cual se selecciona un periodo de lectura.

Lo que tiene que hacer la macro es coger los datos de la columna INCIDENCIA y almacenarlos como comentarios en la columna que se haya seleccionado en el ComboBox llamado "CBoxPeriodo". 

La utilidad de la macro reside en volcar los datos del periodo actual en su respectiva columna de lecturas antes de que sea reiniciado un nuevo periodo de lecturas.

 

De antemano, muy agradecido con cualquier comentario o ayuda al respecto, e incluso ideas de como mejorar el sistema de control de lecturas.

 

Saludos.

macro comentarios.xls

[Antoni]

Private Sub BtGrabar_Click()
Dim celda As Range, x As Long
Application.ScreenUpdating = False
If CBoxPeriodo.ListIndex = -1 Then Exit Sub
With Sheets("PARQUE")
   Set celda = .Range("A1:AZ1").Find(CBoxPeriodo, , , xlWhole)
   .Columns(celda.Column).ClearComments
   For x = 2 To .Range("X" & Rows.Count).End(xlUp).Row
      .Cells(x, celda.Column).AddComment
      .Cells(x, celda.Column).Comment.Text Text:=.Range("X" & x).Value
   Next
End With
Application.ScreenUpdating = True
End Sub

 

[El Perro Juhh]

Maravilloso!

Muchas gracias Antoni, me ha funcionado a la primera.

Solamente matizar un detalle menor, pues ahora estoy intentando filtrar con código que el origen de los datos tenga contenido, ya que si la celda en cuestión está en blanco da un error de ejecución. 

[Antoni]

Private Sub BtGrabar_Click()
Dim celda As Range, x As Long
Application.ScreenUpdating = False
If CBoxPeriodo.ListIndex = -1 Then Exit Sub
With Sheets("PARQUE")
   Set celda = .Range("A1:AZ1").Find(CBoxPeriodo, , , xlWhole)
   .Columns(celda.Column).ClearComments
   For x = 2 To .Range("X" & Rows.Count).End(xlUp).Row
      If Not .Range("X" & x).Value = "" Then
         .Cells(x, celda.Column).AddComment
         .Cells(x, celda.Column).Comment.Text Text:=.Range("X" & x).Value
      End If
   Next
End With
Application.ScreenUpdating = True
End Sub

 

[El Perro Juhh]

Problema resuelto.

Muchas gracias Antoni!

 

[El Perro Juhh]

Hay una cosa que no acabo de entender, por ejemplo en la línea

"For x = 2 To .Range("X" & Rows.Count).End(xlUp).Row"

La X mayúscula es una variable que va cambiando de valor?  O es un parámetro fijo? 

[El Perro Juhh]

Buenos días, tras entender lo de la X mayúscula, que es actualmente la columna INCIDENCIA, he retocado un poco el código para que, en caso que a la tabla se le añadan columnas, como será mi caso, no de error. 

He sustituido la "X" mayúscula que referenciaba a la columna INCIDENCIA por una variable, y utilizado la función que copié de este otro post:

 

Entionces, la función desarrollada por Antoni quedaría así:

Private Sub BtGrabar_Click()
'FUNCION PARA GRABAR LAS INCIDENCIAS DE UN PERIODO SELECCIONADO

Dim celda As Range
Dim incidencia As Range
Dim letraIncidencia As String
Dim x As Long



Application.ScreenUpdating = False

If CBoxPeriodo.ListIndex = -1 Then Exit Sub

With Sheets("PARQUE")

    Set celda = .Range("A1:AZ1").Find(CBoxPeriodo, , , xlWhole)
   .Columns(celda.Column).ClearComments
    
    Set incidencia = .Range("A1:AZ1").Find("INCIDENCIA", , , xlWhole)
    letraIncidencia = ReferenciarColumnas(incidencia.Column)
    
    
   For x = 2 To .Range(letraIncidencia & Rows.Count).End(xlUp).Row
        
        If Not .Range(letraIncidencia & x).Value = "" Then
        
          .Cells(x, celda.Column).AddComment
          .Cells(x, celda.Column).Comment.Text Text:=.Range(letraIncidencia & x).Value
          
        End If
    Next
   
End With

Application.ScreenUpdating = True

End Sub

 

Y la función que devuelve la letra de la columna en cuestión es esta, copiada tal cual del otro post:

Function ReferenciarColumnas(numero As Integer) As String
'FUNCION QUE CONVIERTE A LETRA EL NUMERO DE COLUMNA DE UNA VARIABLE DE TIPO RANGE

Application.ScreenUpdating = False

   ' Tratamos los errores de la función...
   On Error Resume Next

   ' Declaramos las variables de ámbito local...
   Dim letras As Variant
   letras = Split(ThisWorkbook.ActiveSheet.Columns(numero).Address, "$")

   ' Si el número introducido no es válido, entonces...
   If numero <= 0 Or numero > 16384 Then
      ' Notificamos al usuario con un mensaje de error...
      MsgBox Prompt:="Upps, parece que hubo un error... Por favor, el número introducido debe estar " & _
                     "comprendido entre los valores 1 y 16384.", _
             Title:="NUMERO INCORRECTO"
   ' En caso contrario...
   Else
      ' Referenciamos el número de columna...
      ReferenciarColumnas = letras(2)
   End If

End Function

 

[Antoni]

No es necesario recurrir a la columna en letras utilizando la propiedad Cells del objeto Range.

Private Sub BtGrabar_Click()
Dim celda As Range, x As Long, Incidencias As Range
Application.ScreenUpdating = False
If CBoxPeriodo.ListIndex = -1 Then Exit Sub
With Sheets("PARQUE")
   Set celda = .Range("A1:AZ1").Find(CBoxPeriodo, , , xlWhole)
   Set Incidencias = .Range("A1:AZ1").Find("INCIDENCIA", , , xlPart)
   .Columns(celda.Column).ClearComments
   For x = 2 To .Cells(Rows.Count, Incidencias.Column).End(xlUp).Row
      If Not .Cells(x, Incidencias.Column).Value = "" Then
         .Cells(x, celda.Column).AddComment
         .Cells(x, celda.Column).Comment.Text Text:=.Cells(x, Incidencias.Column).Value
      End If
   Next
End With
Application.ScreenUpdating = True
End Sub

 

[El Perro Juhh]

Muchas gracias Antoni por la optimización. 

Un saludo.