Rescatar comentarios ordenados por columna

Gracias Héctor, pero tu código me supera. No tengo tantos conocimientos en
VBA como para estar preparada para hacer una adaptación con ese código. Creí
que era más sencillo cambiar el escaneo de filas a columnas.
Me parece que lo voy a dejar como está.
Saludos
Fran

"Héctor Miguel" escribió en el mensaje de
noticias news:upGM%

hola, Francesca !

(hasta donde se) "por filas" es el orden "natural" como excel "arregla" la
informacion de un "rango de datos" (es decir)
siempre usa las hojas (incluso para los (re)calculos) desde la esquina
superior izquierda hacia la esquina inferior derecha

si usas una instruccion como la siguiente: msgbox
activesheet.cells.specialcells(xlcelltypecomments).address
notaras que en primer lugar aparecera la fila "menor" (independientemente
de en cual columna este el primer comentario)

el siguiente ejemplo, integra una matriz de dos dimensiones (columna y
fila) por cada celda con comentarios
despues, hace un "sorteo-burbuja" para ubicar las columnas de menor a
mayor (ajustando tambien la segunda dimension)
y finalmente, devuelve una matriz "ordenada" por columnas, aunque algunas
filas "pierden su orden natural" :-((

por lo pronto, devuelve el resultado de cada celda en la ventana de
inmediato (alt + G desde el editor de vba)
asi que la instruccion: debug.print... (etc. etc. etc.) es la parte del
bucle final que deberas adaptar para tu rutina original
(ademas de incluir un bucle (mas) externo para el recorrido por cada una
de las hojas (el ejemplo solo trabaja la hoja activa)

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

copia lo siguiente en un modulo de codigo estandar...

Option Base 1
Sub MatrizDeComentariosPorColumna()
Dim Celda As Range, n As Integer, Men(32) As Integer, May(32) As Integer,
_
Pri As Integer, Ult As Integer, n1 As Integer, n2 As Integer, _
x1 As Integer, x2 As Integer, Prov As Integer
With ActiveSheet.Comments: ReDim Mat(.Count, .Count): End With
For Each Celda In ActiveSheet.Cells.SpecialCells(xlCellTypeComments)
n = n + 1: Mat(n, 1) = Celda.Column: Mat(n, 2) = Celda.Row: Next
Pri = LBound(Mat): Ult = UBound(Mat): n = 1: Men(n) = Pri: May(n) = Ult
Do
If Ult > Pri Then
Prov = Mat(Ult, 1): n1 = Pri - 1: n2 = Ult
Do
Do: n1 = n1 + 1: Loop Until Mat(n1, 1) >= Prov
Do: n2 = n2 - 1: Loop Until n2 = Pri Or Mat(n2, 1) <= Prov
x1 = Mat(n1, 1): Mat(n1, 1) = Mat(n2, 1): Mat(n2, 1) = x1
x2 = Mat(n1, 2): Mat(n1, 2) = Mat(n2, 2): Mat(n2, 2) = x2
Loop Until n2 <= n1
x1 = Mat(n2, 1): Mat(n2, 1) = Mat(n1, 1): Mat(n1, 1) = Mat(Ult, 1):
Mat(Ult, 1) = x1
x2 = Mat(n2, 2): Mat(n2, 2) = Mat(n1, 2): Mat(n1, 2) = Mat(Ult, 2):
Mat(Ult, 2) = x2: n = n + 1
If (n1 - Pri) > (Ult - n1) Then
Men(n) = Pri: May(n) = n1 - 1: Pri = n1 + 1
Else: Men(n) = n1 + 1: May(n) = Ult: Ult = n1 - 1
End If
Else: Pri = Men(n): Ult = May(n): n = n - 1: If n = 0 Then Exit Do
End If
Loop
For n = 1 To UBound(Mat)
Debug.Print Cells(Mat(n, 2), Mat(n, 1)).Address
Next
End Sub

__ OP __

... estoy usando un codigo que me permite rescatar los comentarios de
todas las hojas de un libro
pero los busca por fila. Quisiera poder buscarlos por columna. Supongo
que es posible. Se entiende?
Si no se entiende me dicen y tratare de ser mas clara. El codigo es
basicamente este:
Dim Celda As Comment
Dim i As Long
i = 3
For J = 1 To ActiveWorkbook.Sheets.Count
Sheets(J).Select
For Each Celda In Worksheets(J).Comments
Worksheets(ActiveWorkbook.Sheets.Count).Range("A" & i) >> Replace(ActiveSheet.Name, vbLf, "")
Worksheets(ActiveWorkbook.Sheets.Count).Range("B" & i) >> Replace(Celda.Parent, vbLf, "")
Worksheets(ActiveWorkbook.Sheets.Count).Range("C" & i) >> Replace(Celda.Text, vbLf, " ")
i = i + 1
Next Celda
Next J

hola, Francesca !

... No tengo tantos conocimientos en VBA como para... hacer una adaptacion con ese codigo.
Crei que era mas sencillo cambiar el escaneo de filas a columnas.
Me parece que lo voy a dejar como esta...

cual es el sentido de usar la funcion Replace en tu codigo original ???

Worksheets(ActiveWorkbook.Sheets.Count).Range("A" & i) = Replace(ActiveSheet.Name, vbLf, "")
Worksheets(ActiveWorkbook.Sheets.Count).Range("B" & i) = Replace(Celda.Parent, vbLf, "")
Worksheets(ActiveWorkbook.Sheets.Count).Range("C" & i) = Replace(Celda.Text, vbLf, " ")

saludos,
hector.

Para que respete los formatos; por ejemplo si elimino Replace en la línea

Worksheets(ActiveWorkbook.Sheets.Count).Range("B" & i) =
Replace(Celda.Parent, vbLf, "")

y dejo sólo

Celda.Parent

el 10/3/2008 aparece como 39517.

Saludos
Frn


"Héctor Miguel" escribió en el mensaje de
noticias news:

hola, Francesca !

... No tengo tantos conocimientos en VBA como para... hacer una
adaptacion con ese codigo.
Crei que era mas sencillo cambiar el escaneo de filas a columnas.
Me parece que lo voy a dejar como esta...

cual es el sentido de usar la funcion Replace en tu codigo original ???

Worksheets(ActiveWorkbook.Sheets.Count).Range("A" & i) =
Replace(ActiveSheet.Name, vbLf, "")
Worksheets(ActiveWorkbook.Sheets.Count).Range("B" & i) =
Replace(Celda.Parent, vbLf, "")
Worksheets(ActiveWorkbook.Sheets.Count).Range("C" & i) =
Replace(Celda.Text, vbLf, " ")

saludos,
hector.

hola, Francesca !

cual es el sentido de usar la funcion Replace en tu codigo original ???

Para que respete los formatos; por ejemplo si elimino Replace en la linea

Worksheets(ActiveWorkbook.Sheets.Count).Range("B" & i) = Replace(Celda.Parent, vbLf, "")

y dejo solo Celda.Parent el 10/3/2008 aparece como 39517...

(segun yo ?) solo necesitas el "replace" para eliminar saltos de linea en el texto de los comentarios ;)
prueba el siguiente codigo, que no requiere hacer los ".Select" de cada hoja (por lo que debiera ser +/- veloz)
(OJO: como ya te comente, algunas filas "pierden su orden natural" por la forma del recorrido que hace excel)

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Option Base 1

Dim Fila As Long, uHoja As Integer

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
For h = 1 To uHoja: ComentariosPorColumna h: Next
End Sub

Sub ComentariosPorColumna(h As Integer)
Dim Celda As Range, n As Integer, Men(32) As Integer, May(32) As Integer, _
Pri As Integer, Ult As Integer, n1 As Integer, n2 As Integer, _
x1 As Integer, x2 As Integer, Prov As Integer
With Worksheets(h).Comments
If .Count = 0 Then Exit Sub Else ReDim Mat(.Count, .Count)
End With
For Each Celda In Worksheets(h).Cells.SpecialCells(xlCellTypeComments)
n = n + 1: Mat(n, 1) = Celda.Column: Mat(n, 2) = Celda.Row: Next
Pri = LBound(Mat): Ult = UBound(Mat): n = 1: Men(n) = Pri: May(n) = Ult
Do
If Ult > Pri Then
Prov = Mat(Ult, 1): n1 = Pri - 1: n2 = Ult
Do
Do: n1 = n1 + 1: Loop Until Mat(n1, 1) >= Prov
Do: n2 = n2 - 1: Loop Until n2 = Pri Or Mat(n2, 1) <= Prov
x1 = Mat(n1, 1): Mat(n1, 1) = Mat(n2, 1): Mat(n2, 1) = x1
x2 = Mat(n1, 2): Mat(n1, 2) = Mat(n2, 2): Mat(n2, 2) = x2
Loop Until n2 <= n1
x1 = Mat(n2, 1): Mat(n2, 1) = Mat(n1, 1): Mat(n1, 1) = Mat(Ult, 1): Mat(Ult, 1) = x1
x2 = Mat(n2, 2): Mat(n2, 2) = Mat(n1, 2): Mat(n1, 2) = Mat(Ult, 2): Mat(Ult, 2) = x2: n = n + 1
If (n1 - Pri) > (Ult - n1) Then
Men(n) = Pri: May(n) = n1 - 1: Pri = n1 + 1
Else: Men(n) = n1 + 1: May(n) = Ult: Ult = n1 - 1
End If
Else: Pri = Men(n): Ult = May(n): n = n - 1: If n = 0 Then Exit Do
End If
Loop
For n = 1 To UBound(Mat)
With Worksheets(h)
Worksheets(uHoja).Range("a" & Fila & ":c" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, _
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf, " "))
End With: Fila = Fila + 1
Next
End Sub

Hola Héctor. Gracias por tu insistencia en ayudarme. Claro que estoy
completamente perdida con tu código, imposible seguirlo ni entenderlo, como
ya te dije no soy muy entendida en VBA.
Al probarlo me aparece error 9 Subíndice fuera del intervalo. Como no lo
entiendo no puedo determinar por qué se produce... pero al depurar estas son
las líneas que se destacan:

Worksheets(uHoja).Range("a" & Fila & ":c" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, _
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf,
" "))

Saludos
Fran

"Héctor Miguel" escribió en el mensaje de
noticias news:

hola, Francesca !

cual es el sentido de usar la funcion Replace en tu codigo original ???

Para que respete los formatos; por ejemplo si elimino Replace en la linea

Worksheets(ActiveWorkbook.Sheets.Count).Range("B" & i) =
Replace(Celda.Parent, vbLf, "")

y dejo solo Celda.Parent el 10/3/2008 aparece como 39517...

(segun yo ?) solo necesitas el "replace" para eliminar saltos de linea en
el texto de los comentarios ;)
prueba el siguiente codigo, que no requiere hacer los ".Select" de cada
hoja (por lo que debiera ser +/- veloz)
(OJO: como ya te comente, algunas filas "pierden su orden natural" por la
forma del recorrido que hace excel)

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Option Base 1

Dim Fila As Long, uHoja As Integer

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
For h = 1 To uHoja: ComentariosPorColumna h: Next
End Sub

Sub ComentariosPorColumna(h As Integer)
Dim Celda As Range, n As Integer, Men(32) As Integer, May(32) As Integer,
_
Pri As Integer, Ult As Integer, n1 As Integer, n2 As Integer, _
x1 As Integer, x2 As Integer, Prov As Integer
With Worksheets(h).Comments
If .Count = 0 Then Exit Sub Else ReDim Mat(.Count, .Count)
End With
For Each Celda In Worksheets(h).Cells.SpecialCells(xlCellTypeComments)
n = n + 1: Mat(n, 1) = Celda.Column: Mat(n, 2) = Celda.Row: Next
Pri = LBound(Mat): Ult = UBound(Mat): n = 1: Men(n) = Pri: May(n) = Ult
Do
If Ult > Pri Then
Prov = Mat(Ult, 1): n1 = Pri - 1: n2 = Ult
Do
Do: n1 = n1 + 1: Loop Until Mat(n1, 1) >= Prov
Do: n2 = n2 - 1: Loop Until n2 = Pri Or Mat(n2, 1) <= Prov
x1 = Mat(n1, 1): Mat(n1, 1) = Mat(n2, 1): Mat(n2, 1) = x1
x2 = Mat(n1, 2): Mat(n1, 2) = Mat(n2, 2): Mat(n2, 2) = x2
Loop Until n2 <= n1
x1 = Mat(n2, 1): Mat(n2, 1) = Mat(n1, 1): Mat(n1, 1) = Mat(Ult, 1):
Mat(Ult, 1) = x1
x2 = Mat(n2, 2): Mat(n2, 2) = Mat(n1, 2): Mat(n1, 2) = Mat(Ult, 2):
Mat(Ult, 2) = x2: n = n + 1
If (n1 - Pri) > (Ult - n1) Then
Men(n) = Pri: May(n) = n1 - 1: Pri = n1 + 1
Else: Men(n) = n1 + 1: May(n) = Ult: Ult = n1 - 1
End If
Else: Pri = Men(n): Ult = May(n): n = n - 1: If n = 0 Then Exit Do
End If
Loop
For n = 1 To UBound(Mat)
With Worksheets(h)
Worksheets(uHoja).Range("a" & Fila & ":c" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, _
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf,
" "))
End With: Fila = Fila + 1
Next
End Sub