Macro que ordene la información
Publicado por Carol (2 intervenciones) el 09/03/2021 18:48:32
Hola chicos!
Lo que sucede es que los siguientes datos me los entregan así (cabe aclarar que la información solo se encuentra en la columna A):
Categoría 1
a
b
c
d
b1
c1
d1
Categoría 2
z
w
x
y
xy
w1
x1
y1
w2
x2
y2
xy2
w3
x3
y3
w4
x4
y4
xy4
y yo debo ordenarlos así:

Actualmente tengo el siguiente código pero no me lo ordena bien
Estaría muy agradecida con el que me pudiera ayudar a solucionar este macro.
Lo que sucede es que los siguientes datos me los entregan así (cabe aclarar que la información solo se encuentra en la columna A):
Categoría 1
a
b
c
d
b1
c1
d1
Categoría 2
z
w
x
y
xy
w1
x1
y1
w2
x2
y2
xy2
w3
x3
y3
w4
x4
y4
xy4
y yo debo ordenarlos así:
Actualmente tengo el siguiente código pero no me lo ordena bien
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Option Explicit
Option Base 1
Sub obtener()
Dim r As Range, fr%, cr%
Set r = Range("A1").CurrentRegion
Dim z As Object, zs$, M(1 To 5)
Set z = CreateObject("scripting.dictionary")
Dim K As New Collection, ks$, kn%
On Error Resume Next 'para la K
For fr = 1 To r.Rows.Count
zs = r(fr, 1).Row
If r(fr, 1) Like "Categor=*" Then
ks = ""
For cr = 2 To 4
ks = ks & r(fr + cr, 1)
Next
K.Add ks, ks
If K.Count > kn Then
kn = K.Count
Else
fr = fr + 5
GoTo sigue
End If
M(1) = r(fr, 1)
fr = fr + 1
M(2) = r(fr, 1)
fr = fr + 1
M(3) = r(fr, 1)
fr = fr + 1
M(4) = r(fr, 1)
fr = fr + 1
M(5) = r(fr, 1)
z.Add zs, M()
Else
ks = ""
For cr = 0 To 2
ks = ks & r(fr + cr, 1)
Next
K.Add ks, ks
If K.Count > kn Then
kn = K.Count
Else
fr = fr + 2
GoTo sigue
End If
' zs = r(fr, 1).Row
M(1) = Empty
M(2) = Empty
M(3) = r(fr, 1)
fr = fr + 1
M(4) = r(fr, 1)
fr = fr + 1
M(5) = r(fr, 1)
z.Add zs, M()
End If
sigue:
Next
Columns("C:J").ClearContents
Range("C2").Resize(z.Count, 5) = Application.Index(z.items, 0, 0)
End Sub
Estaría muy agradecida con el que me pudiera ayudar a solucionar este macro.
Valora esta pregunta


0