Como Ordenar mi Catalogo de Cuentas Usando Una Macro
Hola Amigos Buen Día
Tengo un pequeño problema tengo un catalogo de cuentas las cuales llevan el siguiente orden
1 Activos
10 Activo Corrientes
101 Cuentas Bancarias
101001 Cuentas Moneda Nacional
101001001 Banco XXXXXX
101001002 Banco XXXXXX
101002 Cuentas Moneda Extranjera
101002001 Banco XXXXXX
102 Cuentas por Cobrar
102001 Clientes
102001001 Cliente XXXX
102001002 Cliente XXXX
El problema que tengo con esta secuencia es que la creación de una cuenta nueva la hago mediante un pequeño formato en una hoja individual luego mediante una macro la información de cada cuenta se copia a la hoja del catalogo de cuentas y al mismo tiempo tiene que ordenar las mismas el problema es que al ordenarla por ser datos numéricos el orden me lo muestra de la siguiente manera
1 activos
10 activos corrientes
101 cuentas bancarias
Y aquí en lugar de insertar la cuenta 101001 me pone la cuenta 102 que corresponde a cuentas por cobrar.
He buscado la manera de ordenar las cuentas de acuerdo al formato que detalle al inicio pero no he podido encontrar la manera de hacerlo
Espero me puedan ayudar ya que esto me ayudaría mucho en mi trabajo
Mil gracias
1 Respuesta
Ya resolví como ordenar tu catálogo. Con esta macro ordenas tus cuentas.
Tus cuentas deben estar en la columna "A", los nombres de las cuentas en la columna "B"
Las cuentas deben empezar en la celda A2.
El número máximo de dígitos en tu cuenta es de 9.
Si alguno de estos datos cambia, deberás adaptar la macro, si no puedes adaptar la macro, avísame para adaptarla.
Prueba en una hoja nueva el funcionamiento de la macro con las características que te comenté.
Te anexo mi archivo para que veas que sí funciona.
https://www.dropbox.com/s/flir30775j5ivuw/ordenar%20cuentas.xlsm
Sub ordenar()
'Por.DAM
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
ci = "A"
h1.Columns("B:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
u = h1.Range(ci & Rows.Count).End(xlUp).Row
h1.Range(h1.Cells(2, ci), h1.Cells(u, ci)).TextToColumns Destination:=h1.Range("B2"), _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), _
Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2)), TrailingMinusNumbers:=True
h1.Range("B2:J" & u).Replace What:="0", Replacement:=".2"
h1.Range("B2:J" & u).Replace What:="", Replacement:=".1"
With h1.Sort
.SortFields.Clear
For i = 2 To 10
.SortFields.Add Key:=h1.Range(h1.Cells(2, i), h1.Cells(u, i))
Next
.SetRange h1.Range("A2:K" & u): .Header = xlGuess: .Apply
End With
For Each c In h1.Range("B2:J" & u)
If c = 0.2 Then c.Value = "'0"
If c = 0.1 Then c.ClearContents
Next
h1.Columns("B:J").Delete
Application.ScreenUpdating = True
End Sub
