Mar 09 2021 08:55 AM
Hello,
I need your help to make a macro that does the following,
They give me the data in this way (all this information is in column A):
Categoría 1 |
a |
b |
c |
d |
b1 |
c1 |
d1 |
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 |
And the macro should convert it like this
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 |
At the moment I have this code but it does not work well for me
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 "PO=*" 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
Which shows me the information in this way:
Categoría 1 | a | b | c |
b1 | c1 | ||
Categoría 2 | z | w | x |
xy | w1 | ||
y1 | w2 | ||
y2 | xy2 | ||
x3 | y3 | ||
x4 | y4 |
Could someone help me on how to do this macro
I would greatly appreciate your help!