Macro para ordenar de menor a mayor celda con valores concatenados
Dante Amor buenos días, necesito ordenar de menor a mayor la celda concatenada A15 de la Hoja1. Adjunto el código fuente usado que funciona a la perfección, pero solo faltaría agregar la macro para ordenar de menor a mayor la celda A15.
Te agradezco de antemano por tu apoyo.
Sub concatenar()
'Por Dante Amor
'
Dim valores As New Collection
'
Set h1 = Sheets("Hoja1") 'resultados
Set h2 = Sheets("Hoja2") 'base de datos
Set valores = Nothing
Set resultado = h1.Range("A15")
valor_a = h1.Range("Q7").Value
'
Set r = h2.Columns("G")
Set b = r.Find(valor_a, LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
valor = h2.Cells(b.Row, "F").Value
existe = False
For j = 1 To valores.Count
If valores(j) = valor Then
existe = True
End If
Next
If existe = False Then
valores.Add valor
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
'
For i = 1 To valores.Count
cad = cad & "/" & valores(i)
Next
Set valores = Nothing
resultado.Value = "'" & Mid(cad, 2)
End Sub
1 respuesta
Respuesta de Dante Amor
1
Te anexo la macro actualizada
Debes poner al principio de toda la macro la declaración
Dim valores As New Collection
Dim valores As New Collection
'
Sub concatenar()
'Por Dante Amor
'
Set h1 = Sheets("Hoja1") 'resultados
Set h2 = Sheets("Hoja2") 'base de datos
Set valores = Nothing
Set resultado = h1.Range("A15")
valor_a = h1.Range("Q7").Value
'
Set r = h2.Columns("G")
Set b = r.Find(valor_a, LookAt:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
valor = h2.Cells(b.Row, "F").Value
Call Agegar_Numero(valor)
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
'
For i = 1 To valores.Count
cad = cad & "/" & valores(i)
Next
Set valores = Nothing
resultado.Value = "'" & Mid(cad, 2)
End Sub
'
Sub Agegar_Numero(n)
'Ordena números en una colección
For i = 1 To valores.Count
If valores(i) = n Then Exit Sub
Next
For i = 1 To valores.Count
If valores(i) > n Then
valores.Add n, before:=i 'si el número almacenado es mayor lo almacena antes
Exit Sub
End If
Next
valores.Add n 'si es el mayor de todos lo agrega al final
End Sub
.
.
