Rescatar comentarios ordenados por columna

hola, Francesca !

... codigo, imposible seguirlo ni entenderlo... no soy muy entendida en VBA.
... me aparece error 9 Subindice fuera del intervalo... no puedo determinar por que se produce
... pero al depurar estas son las lineas 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, " "))

hay algunas diferencias en cuanto a la forma de (re)dimensionar matrices entre vba5 (xl-97) y vba6 (xl-2000 ...>)
es probable que el error sea provocado desde la instruccion donde se establecen las dimensiones -> ReDim Mat(n, n)
usando otra forma para este tipo de declaraciones (no se requiere al inicio del modulo la instruccion "Option Base 1")
y agregando una variable mas (la direccion de la celda donde esta el comentario), es posible que...
las siguientes modificaciones [sin Option Base 1, y modificando el ReDim Mat(n, n)] ya no provoquen este fallo -?-

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

transcribo todo el codigo modificado ==
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(1 To .Count, 1 To 2)
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 & ":d" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, .Cells(Mat(n, 2), Mat(n, 1)).Text, _
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf, " "))
End With: Fila = Fila + 1
Next
End Sub

Hola Héctor, ahora sí funciona y como tú dices mucho más rápido, pero me
sobreescribe la última hoja del libro, además que no respeta los formatos,
por ejemplo 455.000 lo presenta como 455 y 83.451 sale como 83,451 o 237.600
como 237,6 aunque las fechas aparecen bien pero solo los días aparecen con
formato 03, 08, etc. los meses salen con un dígito desde enero a septiembre.
Gracias nuevamente por tu ayuda
Saludos
Fran

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

hola, Francesca !

... codigo, imposible seguirlo ni entenderlo... no soy muy entendida en
VBA.
... me aparece error 9 Subindice fuera del intervalo... no puedo
determinar por que se produce
... pero al depurar estas son las lineas 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, " "))

hay algunas diferencias en cuanto a la forma de (re)dimensionar matrices
entre vba5 (xl-97) y vba6 (xl-2000 ...>)
es probable que el error sea provocado desde la instruccion donde se
establecen las dimensiones -> ReDim Mat(n, n)
usando otra forma para este tipo de declaraciones (no se requiere al
inicio del modulo la instruccion "Option Base 1")
y agregando una variable mas (la direccion de la celda donde esta el
comentario), es posible que...
las siguientes modificaciones [sin Option Base 1, y modificando el ReDim
Mat(n, n)] ya no provoquen este fallo -?-

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

transcribo todo el codigo modificado ==>
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(1 To .Count, 1 To 2)
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 & ":d" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, .Cells(Mat(n,
2), Mat(n, 1)).Text, _
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf,
" "))
End With: Fila = Fila + 1
Next
End Sub

hola, Francesca !

__ 1 __

... ahora si funciona y... mucho mas rapido, pero me sobreescribe la ultima hoja del libro

el (sobre ?)escribir en la "ultima" hoja de libro, solo trate de "conservarlo" de tu codigo original, donde...

1) tienes un bucle que recorre TODAS las hojas del libro (ncluyendo la ultima) donde dice:
For J = 1 To ActiveWorkbook.Sheets.Count

-> el mismo codigo "deposita" EN la ultima hoja del libro (ActiveWorkbook.Sheets.Count)
el resultado de los comentarios (con las instrucciones):
Worksheets(ActiveWorkbook.Sheets.Count).Range("A" & i) = Replace(ActiveSheet.Name, vbLf, "")
(igual para las columnas B y C) -???-

__ 2 __

ademas que no respeta los formatos, por ejemplo 455.000 lo presenta como 455
y 83.451 sale como 83,451 o 237.600 como 237,6 aunque las fechas aparecen bien
pero solo los dias aparecen con formato 03, 08, etc. los meses salen con un dígito desde enero a septiembre...

2) esto (casi seguro) se debe a configuracion regional (separadores) pues vba es "us-centric" (coma=miles, punto=decimales)
(probablemente) sera necesario tambien conservar (en el codigo) el uso que hacias de la funcion Replace -?-
prueba cambiando la parte final del segundo procedimiento para que quede +/- asi:

For n = 1 To UBound(Mat)
With Worksheets(h)
Worksheets(uHoja).Range("a" & Fila & ":d" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, Replace(.Cells(Mat(n, 2), Mat(n, 1)).Text, vbLf, " "), _
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf, " "))
End With: Fila = Fila + 1
Next

claro, a reserva de comprobar/modificar/... que la ultima hoja del libro sea la que ha de "recibir" esta informacion -???-

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

Tienes toda la razón, Héctor y disculpa por no darme cuenta y advertirte,
parece que estaba un poco volada.
Como dije en mi primer post:
"... El código es básicamente este..." (básicamente, ya que no estaba
completo)
En la primeraparte de mi código añadía una hoja pero claro, no eres adivino.
¿Me seguirás ayudando o estás muy enojado cnmigo?
Saludos
Fran

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

hola, Francesca !

__ 1 __

... ahora si funciona y... mucho mas rapido, pero me sobreescribe la
ultima hoja del libro

el (sobre ?)escribir en la "ultima" hoja de libro, solo trate de
"conservarlo" de tu codigo original, donde...

1) tienes un bucle que recorre TODAS las hojas del libro (ncluyendo la
ultima) donde dice:
For J = 1 To ActiveWorkbook.Sheets.Count

-> el mismo codigo "deposita" EN la ultima hoja del libro
(ActiveWorkbook.Sheets.Count)
el resultado de los comentarios (con las instrucciones):
Worksheets(ActiveWorkbook.Sheets.Count).Range("A" & i) =
Replace(ActiveSheet.Name, vbLf, "")
(igual para las columnas B y C) -???-

__ 2 __

ademas que no respeta los formatos, por ejemplo 455.000 lo presenta como
455
y 83.451 sale como 83,451 o 237.600 como 237,6 aunque las fechas aparecen
bien
pero solo los dias aparecen con formato 03, 08, etc. los meses salen con
un dígito desde enero a septiembre...

2) esto (casi seguro) se debe a configuracion regional (separadores) pues
vba es "us-centric" (coma=miles, punto=decimales)
(probablemente) sera necesario tambien conservar (en el codigo) el uso
que hacias de la funcion Replace -?-
prueba cambiando la parte final del segundo procedimiento para que
quede +/- asi:

For n = 1 To UBound(Mat)
With Worksheets(h)
Worksheets(uHoja).Range("a" & Fila & ":d" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address,
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Text, vbLf, " "), _
Replace(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf,
" "))
End With: Fila = Fila + 1
Next

claro, a reserva de comprobar/modificar/... que la ultima hoja del libro
sea la que ha de "recibir" esta informacion -???-

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

hola, Fran !

Como dije en mi primer post:
"... El codigo es basicamente este..." (basicamente, ya que no estaba completo)
En la primera parte de mi codigo anadia una hoja pero claro, no eres adivino.
Me seguiras ayudando o estas muy enojado cnmigo?

don't worry... be happy ! (que yo sepa ?) solo se en(h)ojan los tamales :D
y realmente hay muy pocas cosas que me hagan "enojar" en los foros, como...
uuhmmm !... (bueno, de momento no recuerdo ninguna, pero ya aparecera alguna) ;)

saludos,
hector.