Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Celda con comentario

Janlui

Por Janlui
en Macros y programación VBA

Recommended Posts

JSDJSD Mentor

JSDJSD

publicado
publicado 
Sub ExtraerComentarios()
 
'Definir la hoja donde se colocarán los comentarios
Dim hojaComentarios As Worksheet
Set hojaComentarios = ActiveWorkbook.Sheets("Hoja2")
 
'Extraer los comentarios si se ha seleccionado un rango
If TypeName(Selection) = "Range" Then
     
    'Establecer el rango a inspeccionar
    Set rango = Intersect(Selection, ActiveSheet.UsedRange)
     
    'Recorrer todas las celdas del rango
    For Each celda In rango.Cells
         
        'Obtener el comentario de la celda
        On Error Resume Next
        comentario = celda.Comment.Text
                 
        'Si la celda tiene un comentario
        If Len(comentario) > 0 Then
            fila = fila + 1
             
            'Insertar la direccón de la celda en la columna A
            'y el texto del comentario en la columna B
            hojaComentarios.Range("A" & fila) = celda.Address
            hojaComentarios.Range("B" & fila) = comentario
             
            'Opcional: Borrar el comentario original
            'celda.Comment.Delete
        End If
         
        comentario = ""
        On Error GoTo 0
    Next
End If
 
End Sub

 

Janlui Miembro destacado

Janlui

publicado
  • Autor
publicado

Hola, te explico si pongo esto

existe_comentario = Len(ActiveCell.Comment.Text)

Y si hay comentario, me dice el largo del comentario... pero si Activecell no tiene comentario me manda error

 

Gerson Pineda Mentor

Gerson Pineda

publicado
publicado
Hace 3 horas, Janlui dijo:

Que sentencia debo de realizar para preguntar si una Celda tiene Comentario.

Gracias

A parte de lo aportado por JSD

Con esta linea identificas y seleccionas rápidamente, que celdas contienen comentarios 

Range("A:A").SpecialCells(-4144).Select

 Hace un rato, aporte algo sobre comentarios aqui

La ventaja de usar este método, es que no necesito recorrer celdas que no tengan comentarios, va directo a ellas, por lo tanto el procedimiento es mucho mas eficiente 

 

Saludos 

  • 1 month later...
juan alberto Principiante

juan alberto

publicado
publicado

https://ibb.co/wQb6RFZ

 

En esa imagen deseo una macro que me permita extraer los comentarios incluyendo sus hilos, con la siguiente macro logro exportar el primen comentario pero no el segundo:

Sub ExtraerComentarios()

'Definir la hoja donde se colocarán los comentarios
Dim hojaComentarios As Worksheet
Set hojaComentarios = ActiveWorkbook.Sheets("Status Restricciones")

'Extraer los comentarios si se ha seleccionado un rango
If TypeName(Selection) = "Range" Then
    
    'Establecer el rango a inspeccionar
    Set rango = Intersect(Selection, ActiveSheet.UsedRange)
    
    'Recorrer todas las celdas del rango
    For Each celda In rango.Cells
        
        'Obtener el comentario de la celda
        On Error Resume Next
        comentario = celda.CommentThreaded.Text
                
        'Si la celda tiene un comentario
        If Len(comentario) > 0 Then
            fila = fila + 1
            
            'Insertar la direccón de la celda en la columna A
            'y el texto del comentario en la columna B
            hojaComentarios.Range("A" & fila) = celda.Address
            hojaComentarios.Range("B" & fila) = comentario
            
        End If
        
        comentario = ""
        On Error GoTo 0
    Next
End If

End Sub

 

juan alberto Principiante

juan alberto

publicado
publicado
Hace 48 minutos , juan alberto dijo:

ENLACE DE IMAGEN:

https://ibb.co/5r2HvLH

 

En esa imagen deseo una macro que me permita extraer los comentarios incluyendo sus hilos, con la siguiente macro logro exportar el primen comentario pero no el segundo:

Sub ExtraerComentarios()

'Definir la hoja donde se colocarán los comentarios
Dim hojaComentarios As Worksheet
Set hojaComentarios = ActiveWorkbook.Sheets("Status Restricciones")

'Extraer los comentarios si se ha seleccionado un rango
If TypeName(Selection) = "Range" Then
    
    'Establecer el rango a inspeccionar
    Set rango = Intersect(Selection, ActiveSheet.UsedRange)
    
    'Recorrer todas las celdas del rango
    For Each celda In rango.Cells
        
        'Obtener el comentario de la celda
        On Error Resume Next
        comentario = celda.CommentThreaded.Text
                
        'Si la celda tiene un comentario
        If Len(comentario) > 0 Then
            fila = fila + 1
            
            'Insertar la direccón de la celda en la columna A
            'y el texto del comentario en la columna B
            hojaComentarios.Range("A" & fila) = celda.Address
            hojaComentarios.Range("B" & fila) = comentario
            
        End If
        
        comentario = ""
        On Error GoTo 0
    Next
End If

End Sub

 

ENLACE DE IMAGEN :https://ibb.co/5r2HvLH

juan alberto Principiante

juan alberto

publicado
publicado
Hace 1 hora, Antoni dijo:

Sube tu archivo Excel y pon un ejemplo de lo que tienes y de lo que quieres.

ENLACE DE IMAGEN:

https://ibb.co/5r2HvLH

 

En esa imagen deseo una macro que me permita extraer los comentarios incluyendo sus hilos, con la siguiente macro logro exportar el primen comentario pero no el segundo:

Sub ExtraerComentarios()

'Definir la hoja donde se colocarán los comentarios
Dim hojaComentarios As Worksheet
Set hojaComentarios = ActiveWorkbook.Sheets("Status Restricciones")

'Extraer los comentarios si se ha seleccionado un rango
If TypeName(Selection) = "Range" Then
    
    'Establecer el rango a inspeccionar
    Set rango = Intersect(Selection, ActiveSheet.UsedRange)
    
    'Recorrer todas las celdas del rango
    For Each celda In rango.Cells
        
        'Obtener el comentario de la celda
        On Error Resume Next
        comentario = celda.CommentThreaded.Text
                
        'Si la celda tiene un comentario
        If Len(comentario) > 0 Then
            fila = fila + 1
            
            'Insertar la direccón de la celda en la columna A
            'y el texto del comentario en la columna B
            hojaComentarios.Range("A" & fila) = celda.Address
            hojaComentarios.Range("B" & fila) = comentario
            
        End If
        
        comentario = ""
        On Error GoTo 0
    Next
End If

End Sub

Frank2021 Aficionado

Frank2021

publicado
publicado

Hola,

Te envío mi propuesta 

Public Function ReadComments(ByVal r As Range) As String

    On Error Resume Next
    Dim t As String
    t = r.CommentThreaded.Text & vbCrLf
    
    If t <> "" Then
        Dim comment As Excel.CommentThreaded
        For Each comment In r.CommentThreaded.Replies
            t = t & comment.Text & vbCrLf
        Next
    End If
    
    ReadComment = t

End Function

Ejemplo:

ReadComments(Range("E5"))

donde E5 es una celda con un hilo

Saludos

Antoni Veterano

Antoni

publicado
publicado 
Public Function ReadComments(ByVal r As Range) As String
    On Error Resume Next
    Dim t As String
    t = r.CommentThreaded.Text & vbCrLf
    If t <> "" Then
        Dim comment As Excel.CommentThreaded
        For Each comment In r.CommentThreaded.Replies
            t = t & comment.Text & vbCrLf
        Next
    End If
    ReadComments = t '<----------------
End Function

 

Antoni Veterano

Antoni

publicado
publicado
Hace 2 horas, Antoni dijo:

Sube tu archivo Excel, con imágenes no hacemos nada, y pon un ejemplo de lo que tienes y de lo que quieres.

 

juan alberto Principiante

juan alberto

publicado
publicado
Hace 1 hora, Antoni dijo:

Sube tu archivo Excel, con imágenes no hacemos nada, y pon un ejemplo de lo que tienes y de lo que quieres.

OK,

https://we.tl/t-lhkcIlUI6K

EN ESE ENLACE ESTA EL ARCHIVO, EN LA HOJA "STATUS DE RESTRICCIONES" ME GUSTARÍA UNA MACRO PARA EXPORTAR LOS COMENTARIOS DE LA HOJA "RESTRICCIONES" EN UNA SOLA COLUMNA  ACTUALMENTE UTILIZO UNA MACRO PERO NO ME EXTRAE LOS SUBCOMENTARIOS DE LA CELDA.

EJEMPLO:

EN LA IMAGEN NO SE EXPORTO EL SEGUNDO COMENTARIO DE LA CELDA K19 https://ibb.co/5r2HvLH , LA MACRO SOLO EXPORTO EL PRIMER COMENTARIO https://ibb.co/Mnn5Wcq DE LA CELDA K19

COMO MEJORO LA MACRO??

 

MACRO UTILIZADA:

Sub ExtraerComentarios()

'Definir la hoja donde se colocarán los comentarios
Dim hojaComentarios As Worksheet
Set hojaComentarios = ActiveWorkbook.Sheets("Status Restricciones")

'Extraer los comentarios si se ha seleccionado un rango
If TypeName(Selection) = "Range" Then
    
    'Establecer el rango a inspeccionar
    Set rango = Intersect(Selection, ActiveSheet.UsedRange)
    
    'Recorrer todas las celdas del rango
    For Each celda In rango.Cells
        
        'Obtener el comentario de la celda
        On Error Resume Next
        comentario = celda.CommentThreaded.Text
                
        'Si la celda tiene un comentario
        If Len(comentario) > 0 Then
            fila = fila + 1
            
            'Insertar la direccón de la celda en la columna A
            'y el texto del comentario en la columna B
            hojaComentarios.Range("A" & fila) = celda.Address
            hojaComentarios.Range("B" & fila) = comentario
            
        End If
        
        comentario = ""
        On Error GoTo 0
    Next
End If

End Sub

juan alberto Principiante

juan alberto

publicado
publicado
Hace 2 horas, juan alberto dijo:

Muy agradecido por la función VBA, existe alguna posibilidad de que te mostrara en orden inverso los comentarios, es decir el hilo mas reciente primero???

ya lo solucione agradecido

Antoni Veterano

Antoni

publicado
publicado
Hace 9 horas, juan alberto dijo:

MUY AGRADECIDO, PERO SOLO PARA ENTENDER

QUE SIGNIFICA

  For x = 10 To .Range("B" & Rows.Count).End(xlUp).Row
      For y = 9 To 17 Step 2:

 

Bucle desde la fila 10 hasta la última fila de la con datos de la columna B y dentro de cada fila, bucle desde la columna 9 (I) hasta la columna 17(Q) de 2 en 2, o sea, columnas 9, 11, 13, 15 y 17 (J, L, N, O, Q).

juan alberto Principiante

juan alberto

publicado
publicado
Hace 4 horas, Antoni dijo:

Bucle desde la fila 10 hasta la última fila de la con datos de la columna B y dentro de cada fila, bucle desde la columna 9 (I) hasta la columna 17(Q) de 2 en 2, o sea, columnas 9, 11, 13, 15 y 17 (J, L, N, O, Q).

muy agradecido

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • DiegoPC
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por DiegoPC · publicado

      Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.