Rescatar comentarios ordenados por columna

Me siento superada, no he podido compaginar mi código que agrega una hoja al
final con tu código y me siguen apareciendo igual los números.
Creo que lo mejor es no insistir más y dejar el barrido por filas.
Gracias por toda tu ayuda y no te preocupes, ya tendrás ocasión de
encontrrte con otra consulta mía.
Saludos
Fran

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

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.

hola, Fran ! (solo para variar, esta te la respondo, de atras... pa'lante)

__ 1 __

... no he podido compaginar mi codigo que agrega una hoja al final con tu codigo

__ 2 __

y me siguen apareciendo igual los numeros.

__ 3 __

Creo que lo mejor es no insistir mas y dejar el barrido por filas.
... y no te preocupes, ya tendras ocasion de encontrrte con otra consulta mia.

3) como no me gusta quedarme con (muchas) dudas y tampoco acostumbro dejar las cosas a la mitad...
el siguiente codigo (es practicamente el mismo al que puse "completo" la vez anterior)...
esta probado en las versiones 97 a 2007, incluso intercambiando los separadores (punto/coma <-> miles/decimales)

2) probablemente, en el caso de fechas, y dependiendo de tu configuracion regional, fecha corta en el panel de control...
cuando se "deja" el dato por la macro (hoja con el resultado de los comentarios) excel "toma" el formato/orden/... del sistema
con los numeros (miles, cientos, decimales, formatos de moneda, millares, etc.) no he encontrado diferencias con el dato de origen

1) del ultimo codigo "completo" expuesto en mensajes anteriores, el UNICO que modifique es el primero: -> Sub ListaComentarios()
para contar las hojas actuales del libro (para el bucle), suprimir la actualizacion de la pantalla y agregar una hoja al final (los resultados)
este codigo queda como sigue:

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
Application.ScreenUpdating = False
With Worksheets.Add(After:=Worksheets(uHoja)): .Name = "Comentarios"
For h = 1 To uHoja: ComentariosPorColumna h: Next
.UsedRange.EntireColumn.AutoFit
End With
End Sub

para poder utilizarlo en la version 97, solo cambie la funcion "Replace(..." por otra de hojas de calculo: "Application.Subsitute(..."

solo "por si las dudas", al final vuelvo a poner el codigo "talco...mo" lo probe en esas versiones y...
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

=Dim Fila As Long, uHoja As Integer

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
Application.ScreenUpdating = False
With Worksheets.Add(After:=Worksheets(uHoja)): .Name = "Comentarios"
For h = 1 To uHoja: ComentariosPorColumna h: Next
.UsedRange.EntireColumn.AutoFit
End With
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)
Range("a" & Fila & ":d" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, .Cells(Mat(n, 2), Mat(n, 1)).Text, _
Application.Substitute(.Cells(Mat(n, 2), Mat(n, 1)).Comment.Text, vbLf, " "))
End With: Fila = Fila + 1
Next
End Sub

Héctor, Gracias por tu insistencia.
El código que pusiste al final funciona bien, aunque no soluciona lo de los
formatos. Sigue apareciendo 36,7 si en la celda dice 36.700 o 148 donde dice
148.000
Por cierto, uso Excel 2007 y Windows Vista.
Agradecida
Fran

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

hola, Fran ! (solo para variar, esta te la respondo, de atras...
pa'lante)

__ 1 __

... no he podido compaginar mi codigo que agrega una hoja al final con tu
codigo

__ 2 __

y me siguen apareciendo igual los numeros.

__ 3 __

Creo que lo mejor es no insistir mas y dejar el barrido por filas.
... y no te preocupes, ya tendras ocasion de encontrrte con otra consulta
mia.

3) como no me gusta quedarme con (muchas) dudas y tampoco acostumbro dejar
las cosas a la mitad...
el siguiente codigo (es practicamente el mismo al que puse "completo"
la vez anterior)...
esta probado en las versiones 97 a 2007, incluso intercambiando los
separadores (punto/coma <-> miles/decimales)

2) probablemente, en el caso de fechas, y dependiendo de tu configuracion
regional, fecha corta en el panel de control...
cuando se "deja" el dato por la macro (hoja con el resultado de los
comentarios) excel "toma" el formato/orden/... del sistema
con los numeros (miles, cientos, decimales, formatos de moneda,
millares, etc.) no he encontrado diferencias con el dato de origen

1) del ultimo codigo "completo" expuesto en mensajes anteriores, el UNICO
que modifique es el primero: -> Sub ListaComentarios()
para contar las hojas actuales del libro (para el bucle), suprimir la
actualizacion de la pantalla y agregar una hoja al final (los resultados)
este codigo queda como sigue:

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
Application.ScreenUpdating = False
With Worksheets.Add(After:=Worksheets(uHoja)): .Name = "Comentarios"
For h = 1 To uHoja: ComentariosPorColumna h: Next
.UsedRange.EntireColumn.AutoFit
End With
End Sub

para poder utilizarlo en la version 97, solo cambie la funcion
"Replace(..." por otra de hojas de calculo: "Application.Subsitute(..."

solo "por si las dudas", al final vuelvo a poner el codigo "talco...mo" lo
probe en esas versiones y...
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

=> Dim Fila As Long, uHoja As Integer

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
Application.ScreenUpdating = False
With Worksheets.Add(After:=Worksheets(uHoja)): .Name = "Comentarios"
For h = 1 To uHoja: ComentariosPorColumna h: Next
.UsedRange.EntireColumn.AutoFit
End With
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)
Range("a" & Fila & ":d" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, .Cells(Mat(n,
2), Mat(n, 1)).Text, _
Application.Substitute(.Cells(Mat(n, 2), Mat(n,
1)).Comment.Text, vbLf, " "))
End With: Fila = Fila + 1
Next
End Sub

Hola Héctor, de verdad que no vale la pena seguir insistiendo, no es tan
grave para mí dejar los comentarios por fila. Te agradezco igual
infinitamente tu ayuda y buena disposición para ayudarme pero ya no se está
justificando que inviertas tu tiempo en esto y para mí tampoco. Pierde
cuidado, ya pondré otra pregunta. Nunca me imaginé que fuera tan complicado
si lo hubiese sabido ni siquiera lo habría posteado, créeme, estoy siendo
super sincera.
Saludos
Francesca

"Francesca Brasso" escribió en el mensaje de
noticias news:%

Héctor, Gracias por tu insistencia.
El código que pusiste al final funciona bien, aunque no soluciona lo de
los formatos. Sigue apareciendo 36,7 si en la celda dice 36.700 o 148
donde dice 148.000
Por cierto, uso Excel 2007 y Windows Vista.
Agradecida
Fran

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

hola, Fran ! (solo para variar, esta te la respondo, de atras...
pa'lante)

__ 1 __

... no he podido compaginar mi codigo que agrega una hoja al final con
tu codigo

__ 2 __

y me siguen apareciendo igual los numeros.

__ 3 __

Creo que lo mejor es no insistir mas y dejar el barrido por filas.
... y no te preocupes, ya tendras ocasion de encontrrte con otra
consulta mia.

3) como no me gusta quedarme con (muchas) dudas y tampoco acostumbro
dejar las cosas a la mitad...
el siguiente codigo (es practicamente el mismo al que puse "completo"
la vez anterior)...
esta probado en las versiones 97 a 2007, incluso intercambiando los
separadores (punto/coma <-> miles/decimales)

2) probablemente, en el caso de fechas, y dependiendo de tu configuracion
regional, fecha corta en el panel de control...
cuando se "deja" el dato por la macro (hoja con el resultado de los
comentarios) excel "toma" el formato/orden/... del sistema
con los numeros (miles, cientos, decimales, formatos de moneda,
millares, etc.) no he encontrado diferencias con el dato de origen

1) del ultimo codigo "completo" expuesto en mensajes anteriores, el UNICO
que modifique es el primero: -> Sub ListaComentarios()
para contar las hojas actuales del libro (para el bucle), suprimir la
actualizacion de la pantalla y agregar una hoja al final (los resultados)
este codigo queda como sigue:

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
Application.ScreenUpdating = False
With Worksheets.Add(After:=Worksheets(uHoja)): .Name = "Comentarios"
For h = 1 To uHoja: ComentariosPorColumna h: Next
.UsedRange.EntireColumn.AutoFit
End With
End Sub

para poder utilizarlo en la version 97, solo cambie la funcion
"Replace(..." por otra de hojas de calculo: "Application.Subsitute(..."

solo "por si las dudas", al final vuelvo a poner el codigo "talco...mo"
lo probe en esas versiones y...
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

=>> Dim Fila As Long, uHoja As Integer

Sub ListaComentarios()
Dim h As Integer: uHoja = Worksheets.Count: Fila = 3
Application.ScreenUpdating = False
With Worksheets.Add(After:=Worksheets(uHoja)): .Name = "Comentarios"
For h = 1 To uHoja: ComentariosPorColumna h: Next
.UsedRange.EntireColumn.AutoFit
End With
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)
Range("a" & Fila & ":d" & Fila).Value = _
Array(.Name, .Cells(Mat(n, 2), Mat(n, 1)).Address, .Cells(Mat(n,
2), Mat(n, 1)).Text, _
Application.Substitute(.Cells(Mat(n, 2), Mat(n,
1)).Comment.Text, vbLf, " "))
End With: Fila = Fila + 1
Next
End Sub