Macro para separar

hola, (...) ?

suponiendo que la tabla original esta en la "hoja1"... que los titulos estan en la fila 1...
que los datos inician en la fila 2... y que estamos hablando de las columnas A:D -???-

el siguiente ejemplo agrega una hoja nueva con la distribucion de los datos como en tu ejemplo
(aunque la "tabla tabulada/espaciada" no paso muy bien que digamos -visualmente-) :-((

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Sub Nueva_distribucion_de_datos()
Application.ScreenUpdating = False
Dim Celda As Range, FilaX As Integer, nFilas As Byte, nDesc As Byte, _
Sig As Byte, RefDes As String
With Worksheets("hoja1")
Worksheets.Add After:=Worksheets(.Index)
FilaX = .Range("a65536").End(xlUp).Row
For Each Celda In .Range("a2:a" & FilaX).SpecialCells(xlCellTypeConstants)
If Celda.Row = FilaX Then nFilas = .Range("c65536").End(xlUp).Row - Celda.Row + 1 _
Else nFilas = IIf(Celda.Offset(, 1) = "", 1, Celda.End(xlDown).Row - Celda.Row)
With Range("a65536").End(xlUp).Offset(Sig + 1)
Sig = Celda.Offset(, 4) - (Celda.Offset(, 4) = 0)
.Resize(, 5).Value = Celda.Resize(, 5).Value: RefDes = ""
If Celda.Offset(, 4) Then
For nDesc = 1 To nFilas: RefDes = RefDes & Celda.Offset(nDesc - 1, 2): Next
.Offset(, 2).Resize(Sig).Value = _
Evaluate("{""" & Application.Substitute(RefDes, ",", """;""") & """}")
.Offset(, 3).Resize(Sig, 2).Value = Celda.Offset(, 3).Resize(, 2).Value
End If
End With
Next
Range("a1").Resize(, 5).Value = .Range("a1").Resize(, 5).Value
End With
Range("a1").Resize(, 5).EntireColumn.AutoFit
End Sub

__ la consulta original __

... macro que me separe por columna datos de una celda en especifica.
Por ejemplo, tengo mi tabla:
Level Item Number Ref Des Item Description Quantity
0 G0100023-461 PCA DRGC-2C 0
1 G600002-105-461 C7,C714,C732,C734, CCAP,1uF,0402,X5 12
C756,C768,C781,C875,
C927,C1093,C1114,
C1117
1 G611009-107-461 C401,C402,C406, TCAP,100uF,7343 5
C408,C1404
Lo que necesito es separar la lista de materiales por "ref des", es decir, me gustaria tener un resultado asi:
Level Item Number Ref Des Description Quantity
0 G0100023-461 PCA DRGC-2C 0

1 G600002-105-461 C7 CCAP,1uF,0402,X5 12
C714 CCAP,1uF,0402,X5 12
C732 CCAP,1uF,0402,X5 12
C734 CCAP,1uF,0402,X5 12
C756 CCAP,1uF,0402,X5 12
C768 CCAP,1uF,0402,X5 12
C781 CCAP,1uF,0402,X5 12
C875 CCAP,1uF,0402,X5 12
C927 CCAP,1uF,0402,X5 12
C1093 CCAP,1uF,0402,X5 12
C1114 CCAP,1uF,0402,X5 12
C1117 CCAP,1uF,0402,X5 12

1 G611009-107-461 C401 TCAP,100uF,7343 5
C402 TCAP,100uF,7343 5
C406 TCAP,100uF,7343 5
C408 TCAP,100uF,7343 5
C1404 TCAP,100uF,7343 5

En si la tabla tiene mas de 50 numeros de parte con sus respectivvos "Ref des"
lo que no puedo es separarlos, y acomodarlos como el ejemplo.

Gracias,,
fijate que se detiene la macro en este paso:

Sig = Celda.Offset(, 4) - (Celda.Offset(, 4) = 0)

lo cambie a ingles y no funciona,
el error dice
Error "13"
Type mismatch








"Héctor Miguel" wrote:

hola, (...) ?

suponiendo que la tabla original esta en la "hoja1"... que los titulos estan en la fila 1...
que los datos inician en la fila 2... y que estamos hablando de las columnas A:D -???-

el siguiente ejemplo agrega una hoja nueva con la distribucion de los datos como en tu ejemplo
(aunque la "tabla tabulada/espaciada" no paso muy bien que digamos -visualmente-) :-((

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Sub Nueva_distribucion_de_datos()
Application.ScreenUpdating = False
Dim Celda As Range, FilaX As Integer, nFilas As Byte, nDesc As Byte, _
Sig As Byte, RefDes As String
With Worksheets("hoja1")
Worksheets.Add After:=Worksheets(.Index)
FilaX = .Range("a65536").End(xlUp).Row
For Each Celda In .Range("a2:a" & FilaX).SpecialCells(xlCellTypeConstants)
If Celda.Row = FilaX Then nFilas = .Range("c65536").End(xlUp).Row - Celda.Row + 1 _
Else nFilas = IIf(Celda.Offset(, 1) = "", 1, Celda.End(xlDown).Row - Celda.Row)
With Range("a65536").End(xlUp).Offset(Sig + 1)
Sig = Celda.Offset(, 4) - (Celda.Offset(, 4) = 0)
.Resize(, 5).Value = Celda.Resize(, 5).Value: RefDes = ""
If Celda.Offset(, 4) Then
For nDesc = 1 To nFilas: RefDes = RefDes & Celda.Offset(nDesc - 1, 2): Next
.Offset(, 2).Resize(Sig).Value = _
Evaluate("{""" & Application.Substitute(RefDes, ",", """;""") & """}")
.Offset(, 3).Resize(Sig, 2).Value = Celda.Offset(, 3).Resize(, 2).Value
End If
End With
Next
Range("a1").Resize(, 5).Value = .Range("a1").Resize(, 5).Value
End With
Range("a1").Resize(, 5).EntireColumn.AutoFit
End Sub

__ la consulta original __
> ... macro que me separe por columna datos de una celda en especifica.
> Por ejemplo, tengo mi tabla:
> Level Item Number Ref Des Item Description Quantity
> 0 G0100023-461 PCA DRGC-2C 0
> 1 G600002-105-461 C7,C714,C732,C734, CCAP,1uF,0402,X5 12
> C756,C768,C781,C875,
> C927,C1093,C1114,
> C1117
> 1 G611009-107-461 C401,C402,C406, TCAP,100uF,7343 5
> C408,C1404
> Lo que necesito es separar la lista de materiales por "ref des", es decir, me gustaria tener un resultado asi:
> Level Item Number Ref Des Description Quantity
> 0 G0100023-461 PCA DRGC-2C 0
>
> 1 G600002-105-461 C7 CCAP,1uF,0402,X5 12
> C714 CCAP,1uF,0402,X5 12
> C732 CCAP,1uF,0402,X5 12
> C734 CCAP,1uF,0402,X5 12
> C756 CCAP,1uF,0402,X5 12
> C768 CCAP,1uF,0402,X5 12
> C781 CCAP,1uF,0402,X5 12
> C875 CCAP,1uF,0402,X5 12
> C927 CCAP,1uF,0402,X5 12
> C1093 CCAP,1uF,0402,X5 12
> C1114 CCAP,1uF,0402,X5 12
> C1117 CCAP,1uF,0402,X5 12
>
> 1 G611009-107-461 C401 TCAP,100uF,7343 5
> C402 TCAP,100uF,7343 5
> C406 TCAP,100uF,7343 5
> C408 TCAP,100uF,7343 5
> C1404 TCAP,100uF,7343 5
>
> En si la tabla tiene mas de 50 numeros de parte con sus respectivvos "Ref des"
> lo que no puedo es separarlos, y acomodarlos como el ejemplo.

hola, (...) ???

fijate que se detiene la macro en este paso:
Sig = Celda.Offset(, 4) - (Celda.Offset(, 4) = 0)
lo cambie a ingles y no funciona, el error dice Error "13" Type mismatch

1) "que" es lo que cambias/te a ingles ???

2) como te comentaba en el mensaje anterior...
"(aunque la "tabla tabulada/espaciada" no paso muy bien que digamos -visualmente-)"
-> este es el "arreglo" y los supuestos utilizados para desarrollar el codigo:

a) nombre de la hoja: "hoja1"
b) titulos en la fila1: [A1] Level, [B1] Item Number, [C1] Ref Des, [D1] Item Description, [E1] Quantity
c) datos en la columna A: [A2] 0, [A3] 1, [A7] 1
d) datos en la columna B: [B2] G0100023-461, [B3] G600002-105-461, [B7] G611009-107-461
e) datos en la columna C:
[C2] <vacia>
[C3] C7,C714,C732,C734,
[C4] C756,C768,C781,C875,
[C5] C927,C1093,C1114,
[C6] C1117
[C7] C401,C402,C406,
[C8] C408,C1404
f) datos en la columna D: [D2] PCA DRGC-2C, [D3] CCAP,1uF,0402,X5, [D7] TCAP,100uF,7343
g) datos en la columna E: [D2] 0, [E3] 12, [E7] 5

3) segun este arreglo, asumo que la columna E contiene el numero de "Ref Desc" (Quantity)...
-> que en la columna C aparecen "separados" por una coma (hasta completar las n_desc) -?-

si alguno de estos supuestos es diferente de "la realidad" (que pinta para ser lo mas seguro)...
-> podrias indicar los rangos donde esta (realmente) cada uno de los datos ?
(en lugar de usar el tabulador y/o espacios para tratar de simular el arreglo de una hoja de calculo ?)
-> y no te olvides de comentar "que" es lo que cambias/te "a ingles" -???-

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Que tal.

Lo que cambie a ingles fue la palabra "celda", me di cuenta de que era parte
del areglo que hiciste. Ese ya no es problema.

-El problema es que cuando se topa con una celda que tiene mas de 200 ref
des. para la macro por un error.

-la tabla que tengo yo, no tiene lineas en blanco, todos lineas estan
seguidas.
-El resultado cres que lo pueda generar sin lineas en blanco?


Mil gracias.
Eres un genio!!!!








"Héctor Miguel" wrote:

hola, (...) ???

> fijate que se detiene la macro en este paso:
> Sig = Celda.Offset(, 4) - (Celda.Offset(, 4) = 0)
> lo cambie a ingles y no funciona, el error dice Error "13" Type mismatch

1) "que" es lo que cambias/te a ingles ???

2) como te comentaba en el mensaje anterior...
"(aunque la "tabla tabulada/espaciada" no paso muy bien que digamos -visualmente-)"
-> este es el "arreglo" y los supuestos utilizados para desarrollar el codigo:

a) nombre de la hoja: "hoja1"
b) titulos en la fila1: [A1] Level, [B1] Item Number, [C1] Ref Des, [D1] Item Description, [E1] Quantity
c) datos en la columna A: [A2] 0, [A3] 1, [A7] 1
d) datos en la columna B: [B2] G0100023-461, [B3] G600002-105-461, [B7] G611009-107-461
e) datos en la columna C:
[C2] <vacia>
[C3] C7,C714,C732,C734,
[C4] C756,C768,C781,C875,
[C5] C927,C1093,C1114,
[C6] C1117
[C7] C401,C402,C406,
[C8] C408,C1404
f) datos en la columna D: [D2] PCA DRGC-2C, [D3] CCAP,1uF,0402,X5, [D7] TCAP,100uF,7343
g) datos en la columna E: [D2] 0, [E3] 12, [E7] 5

3) segun este arreglo, asumo que la columna E contiene el numero de "Ref Desc" (Quantity)...
-> que en la columna C aparecen "separados" por una coma (hasta completar las n_desc) -?-

si alguno de estos supuestos es diferente de "la realidad" (que pinta para ser lo mas seguro)...
-> podrias indicar los rangos donde esta (realmente) cada uno de los datos ?
(en lugar de usar el tabulador y/o espacios para tratar de simular el arreglo de una hoja de calculo ?)
-> y no te olvides de comentar "que" es lo que cambias/te "a ingles" -???-

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

hola, (...) ?

Lo que cambie a ingles fue la palabra "celda", me di cuenta de que era parte del areglo que hiciste. Ese ya no es problema.
-El problema es que cuando se topa con una celda que tiene mas de 200 ref des. para la macro por un error.
-la tabla que tengo yo, no tiene lineas en blanco, todos lineas estan seguidas.
-El resultado cres que lo pueda generar sin lineas en blanco? (...)

1) la palabra "Celda" corresponde a una variable declarada que no interfiere con el idioma ;)

2) si en tu listado existe algun "Item Description" con mas de 255 "Ref Des" cambia a las variables el tipo asignado...
de "As Byte" a: -> "As Integer" (As Byte tiene un alcance de 0 a 255, As Integer cubre +/- hasta 32,767) p.e.
modifica las lineas donde se declaran las variables (y sus tipos)

de:
Dim Celda As Range, FilaX As Integer, nFilas As Byte, nDesc As Byte, _
Sig As Byte, RefDes As String

a:
Dim Celda As Range, FilaX As Integer, nFilas As Integer, nDesc As Integer, _
Sig As Integer, RefDes As String

3) lo de generar el resultado "sin lineas en blanco"... (si pudieras ser mas especifico -???-)

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.