Newsgrupos.com  

Retroceder   Newsgrupos.com > Forum > Newsgroup microsoft.public.es.* 1 Foro > Newsgroup microsoft.public.es.excel
Registrarse Preguntas Frecuentes Lista de Foreros Calendario Buscar Temas de Hoy Marcar Foros Como Leídos




Respuesta
 
LinkBack Herramientas Desplegado
  #1 (permalink)  
Antiguo 22-07-2008, 16:45:00
Manny_90
 
Mensajes: n/a
Predeterminado Macro para acomodar datos

Que tal.

Mil disculpas por hacer el mensaje tan largo.
Me gustaria que me ayudaran a desarrollar una macro para acomosar una serie
de datos.
En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des,
D1-Qty, E1-Item Description. En la columna de Ref des tiene la lista de las
locaciones existentes de un numero de parte (R1, R2, R3, etc), lo que me
gustaria hacer es separar esa informacion , es decir, que la macro cree otra
hoja y acomode la misma informacion (apartir del numero de parte de nivel 0)
pero con los "REF DES" listados en los renglones correspondientes, es decir,
si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los
ref des con la misma informacion del numero de parte, el resultado seria mas
o menos como una base de datos. abajo hice una tabla de ejemplo y otra tabla
como me gustaria tener el resultado. Pueden tomar estos datos y pegarlos en
una hoja de calculo para que tengan mejor vision de la tabla.

OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o
tres letras como LED1, LED2; Todos los datos estan separados por una coma. Y
notese tambien de que no tiene espacios.

Muchas gracias AMIGOS
Saludos desde Chihuahua Mexico


Level Item Number Ref Des Qty Item Description
0 SAA5966-07 1 SUB ASSY, SHADOWCAT MAIN BOARD
1 01-0000-C1 R126,R132,R143,R185,R186,R218,R258,R275,R276,R279 10 RES, 0.00,
0.1W, FILM, 0603
1 01-0000-D1 R28,R29,R31,R32,R33,R38,R40,R106,R108,R127,R150,R1 69,R239,R270,R272,R280 16 RES, 0.00, 0.0625W, FILM, 0402
1 01-0001-D1 R184 1 RES, 68.1K, 0.0625W, 1%, FILM, 0402
1 01-0004-A1 RP2,RP5,RP8,RP9,RP16 5 RES ARRAY, 33, 0.0625W, 5%, FILM, SM,
0402X4
1 01-0018-D1 R144 1 RES, 2.32K, 0.0625W, 1%, FILM, 0402
1 01-0024-D1 R213 1 RES, 40.2K, 0.0625W, 1%, FILM, 0402
1 01-0027-A1 RP11,RP12,RP13,RP14 4 RES ARRAY, 75, 0.0625W, 5%, FILM, SM,
0402X4, CONVEX
1 01-0034-F1 R68 1 RES, 0.035, 0.25W, 1%, FILM, 1206
1 01-0068-01 1 RES, 0.068, 1W, 1%, FILM, 2512
1 01-1000-01 R273 1 RES, 10, 0.25W, 5%, FILM, 1206
1 01-1000-B1 R161,R163,R167 3 RES, 10, 0.125W, 5%, FILM, 0805
1 01-1000-C1 R201 1 RES, 10, 0.1W, 5%, FILM, 0603



La informacion la quiero aarreglar para tener un resultado asi:

Level Item Number Ref Des Qty Item Description
0 SAA5966-07 1 SUB ASSY, SHADOWCAT MAIN BOARD
1 01-0000-C1 R126 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R132 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R143 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R185 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R186 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R218 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R258 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R275 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R276 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-C1 R279 1 RES, 0.00, 0.1W, FILM, 0603
1 01-0000-D1 R28 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R29 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R31 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R32 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R33 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R38 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R40 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R106 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R108 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R127 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R150 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R169 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R239 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R270 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R272 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0000-D1 R280 1 RES, 0.00, 0.0625W, FILM, 0402
1 01-0001-D1 R184 1 RES, 68.1K, 0.0625W, 1%, FILM, 0402
1 01-0004-A1 RP2 1 RES ARRAY, 33, 0.0625W, 5%, FILM, SM, 0402X4
1 01-0004-A1 RP5 1 RES ARRAY, 33, 0.0625W, 5%, FILM, SM, 0402X4
1 01-0004-A1 RP8 1 RES ARRAY, 33, 0.0625W, 5%, FILM, SM, 0402X4
1 01-0004-A1 RP9 1 RES ARRAY, 33, 0.0625W, 5%, FILM, SM, 0402X4
1 01-0004-A1 RP16 1 RES ARRAY, 33, 0.0625W, 5%, FILM, SM, 0402X4

Responder Con Cita
Alt Today
Advertising
Google Adsense
 
This advertising will not be shown
in this way to registered members.
Register your free account today
and become a member on
Newsgrupos.com
Standard Sponsored Links

  #2 (permalink)  
Antiguo 23-07-2008, 00:20:59
Héctor Miguel
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

hola, !

el siguiente ejemplo "asume" que ha existe una "Hoja2", OJO que siempre se eliminan sus datos y se reemplazan por la macro:

Sub Lista_partes()
Dim Fila As Integer, Level As Byte, iNumber As String, RefDes As String, Qty As Integer, iDesc As String
With Worksheets("hoja2")
.Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
End With
With Worksheets("hoja1")
For Fila = 2 To .Range("a65536").End(xlUp).Row
Level = .Range("a" & Fila)
iNumber = .Range("b" & Fila)
RefDes = .Range("c" & Fila)
Qty = .Range("d" & Fila)
iDesc = .Range("e" & Fila)
With Worksheets("hoja2")
With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
.Offset() = Level
.Offset(, 1) = iNumber
.Offset(, 2) = Application.Transpose(Split(RefDes, ","))
.Offset(, 3) = 1
.Offset(, 4) = iDesc
End With
End With
Next
End With
Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
End Sub

OJO: la funcion de vba "Split" requiere de VBA6 (excel 2000 en adelante)
si piensas utilizarla en la version 97 de excel (VBA5) deberas proveerla, poniendo al inicio de tu modulo lo siguiente:

#If Not VBA6 Then
Function Split(Cadena As String, Delimitador As String) As Variant
Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
End Function
#End If

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

> En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des, D1-Qty, E1-Item Description.
> En la columna de Ref des tiene la lista de las locaciones existentes de un numero de parte (R1, R2, R3, etc)
> lo que me gustaria hacer es separar esa informacion... que la macro cree otra hoja y acomode la misma informacion
> (apartir del numero de parte de nivel 0) pero con los "REF DES" listados en los renglones correspondientes
> ... si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los ref des con la misma informacion del numero de parte
> el resultado seria mas o menos como una base de datos.
> abajo hice una tabla de ejemplo y otra tabla como me gustaria tener el resultado.
> Pueden tomar estos datos y pegarlos en una hoja de calculo para que tengan mejor vision de la tabla.
>
> OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o tres letras como LED1, LED2;
> Todos los datos estan separados por una coma. Y notese tambien de que no tiene espacios (...)


<< ya sabes que las "tablas" usando espacios y tabulaciones NO "pasan" como quisieras en los lectores de noticias >> :-((


Responder Con Cita
  #3 (permalink)  
Antiguo 23-07-2008, 15:16:07
Manny_90
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

EXELENTEEEEEEEEEEEE!!!!!!

Solo un pequeno detalle, hay renglones que tienen 57 y 83 Ref des (267 & 404
caracteres respectivamente) y en el resultado de esos numeros de parte no
lista los REF DES, solo captura #VALUE!. Uso Excel 97.

Ahora, el problema es de que en ocaciones tengo archivos donde contienen mas
de 1000 ref des....

Espero y haya solucion a eso....
Mil gracias













"Héctor Miguel" wrote:

> hola, !
>
> el siguiente ejemplo "asume" que ha existe una "Hoja2", OJO que siempre se eliminan sus datos y se reemplazan por la macro:
>
> Sub Lista_partes()
> Dim Fila As Integer, Level As Byte, iNumber As String, RefDes As String, Qty As Integer, iDesc As String
> With Worksheets("hoja2")
> .Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
> End With
> With Worksheets("hoja1")
> For Fila = 2 To .Range("a65536").End(xlUp).Row
> Level = .Range("a" & Fila)
> iNumber = .Range("b" & Fila)
> RefDes = .Range("c" & Fila)
> Qty = .Range("d" & Fila)
> iDesc = .Range("e" & Fila)
> With Worksheets("hoja2")
> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
> .Offset() = Level
> .Offset(, 1) = iNumber
> .Offset(, 2) = Application.Transpose(Split(RefDes, ","))
> .Offset(, 3) = 1
> .Offset(, 4) = iDesc
> End With
> End With
> Next
> End With
> Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
> End Sub
>
> OJO: la funcion de vba "Split" requiere de VBA6 (excel 2000 en adelante)
> si piensas utilizarla en la version 97 de excel (VBA5) deberas proveerla, poniendo al inicio de tu modulo lo siguiente:
>
> #If Not VBA6 Then
> Function Split(Cadena As String, Delimitador As String) As Variant
> Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
> End Function
> #End If
>
> si cualquier duda (o informacion adicional)... comentas ?
> saludos,
> hector.
>
> > En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des, D1-Qty, E1-Item Description.
> > En la columna de Ref des tiene la lista de las locaciones existentes de un numero de parte (R1, R2, R3, etc)
> > lo que me gustaria hacer es separar esa informacion... que la macro cree otra hoja y acomode la misma informacion
> > (apartir del numero de parte de nivel 0) pero con los "REF DES" listados en los renglones correspondientes
> > ... si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los ref des con la misma informacion del numero de parte
> > el resultado seria mas o menos como una base de datos.
> > abajo hice una tabla de ejemplo y otra tabla como me gustaria tener el resultado.
> > Pueden tomar estos datos y pegarlos en una hoja de calculo para que tengan mejor vision de la tabla.
> >
> > OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o tres letras como LED1, LED2;
> > Todos los datos estan separados por una coma. Y notese tambien de que no tiene espacios (...)

>
> << ya sabes que las "tablas" usando espacios y tabulaciones NO "pasan" como quisieras en los lectores de noticias >> :-((
>
>
>

Responder Con Cita
  #4 (permalink)  
Antiguo 07-08-2008, 17:16:01
Manny_90
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

qUE TAL.. MUCHAS GRACIAS,, sabes que tengo un problema, el macro se para en
la linea:


With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)


Ya no avanza y el error que genera es:
Run-time error '1004':
Aplication defined or object defined error

HELP.......................


"Manny_90" wrote:

> EXELENTEEEEEEEEEEEE!!!!!!
>
> Solo un pequeno detalle, hay renglones que tienen 57 y 83 Ref des (267 & 404
> caracteres respectivamente) y en el resultado de esos numeros de parte no
> lista los REF DES, solo captura #VALUE!. Uso Excel 97.
>
> Ahora, el problema es de que en ocaciones tengo archivos donde contienen mas
> de 1000 ref des....
>
> Espero y haya solucion a eso....
> Mil gracias
>
>
>
>
>
>
>
>
>
>
>
>
>
> "Héctor Miguel" wrote:
>
> > hola, !
> >
> > el siguiente ejemplo "asume" que ha existe una "Hoja2", OJO que siempre se eliminan sus datos y se reemplazan por la macro:
> >
> > Sub Lista_partes()
> > Dim Fila As Integer, Level As Byte, iNumber As String, RefDes As String, Qty As Integer, iDesc As String
> > With Worksheets("hoja2")
> > .Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
> > End With
> > With Worksheets("hoja1")
> > For Fila = 2 To .Range("a65536").End(xlUp).Row
> > Level = .Range("a" & Fila)
> > iNumber = .Range("b" & Fila)
> > RefDes = .Range("c" & Fila)
> > Qty = .Range("d" & Fila)
> > iDesc = .Range("e" & Fila)
> > With Worksheets("hoja2")
> > With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
> > .Offset() = Level
> > .Offset(, 1) = iNumber
> > .Offset(, 2) = Application.Transpose(Split(RefDes, ","))
> > .Offset(, 3) = 1
> > .Offset(, 4) = iDesc
> > End With
> > End With
> > Next
> > End With
> > Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
> > End Sub
> >
> > OJO: la funcion de vba "Split" requiere de VBA6 (excel 2000 en adelante)
> > si piensas utilizarla en la version 97 de excel (VBA5) deberas proveerla, poniendo al inicio de tu modulo lo siguiente:
> >
> > #If Not VBA6 Then
> > Function Split(Cadena As String, Delimitador As String) As Variant
> > Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
> > End Function
> > #End If
> >
> > si cualquier duda (o informacion adicional)... comentas ?
> > saludos,
> > hector.
> >
> > > En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des, D1-Qty, E1-Item Description.
> > > En la columna de Ref des tiene la lista de las locaciones existentes de un numero de parte (R1, R2, R3, etc)
> > > lo que me gustaria hacer es separar esa informacion... que la macro cree otra hoja y acomode la misma informacion
> > > (apartir del numero de parte de nivel 0) pero con los "REF DES" listados en los renglones correspondientes
> > > ... si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los ref des con la misma informacion del numero de parte
> > > el resultado seria mas o menos como una base de datos.
> > > abajo hice una tabla de ejemplo y otra tabla como me gustaria tener el resultado.
> > > Pueden tomar estos datos y pegarlos en una hoja de calculo para que tengan mejor vision de la tabla.
> > >
> > > OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o tres letras como LED1, LED2;
> > > Todos los datos estan separados por una coma. Y notese tambien de que no tiene espacios (...)

> >
> > << ya sabes que las "tablas" usando espacios y tabulaciones NO "pasan" como quisieras en los lectores de noticias >> :-((
> >
> >
> >

Responder Con Cita
  #5 (permalink)  
Antiguo 07-08-2008, 18:04:49
Héctor Miguel
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

hola, !

> ... tengo un problema, el macro se para en la linea:
> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
> Ya no avanza y el error que genera es: Run-time error '1004': Aplication defined or object defined error


la variable Qty es tomada por el codigo en esta linea:
>> > Qty = .Range("d" & Fila)

lo que supone/espera/asume/requiere/... que en la columna D de la fila "en turno" exista un valor numerico
que es el numero de "items" que seran trasladados -> previa "ampliacion" del rango por al instruccion .Resize(Qty)

comentas (si hubiera) algun detalle en el tintero ?
saludos,
hector.

__ OP __
>>> el siguiente ejemplo "asume" que ha existe una "Hoja2", OJO que siempre se eliminan sus datos y se reemplazan por la macro:
>>>
>>> Sub Lista_partes()
>>> Dim Fila As Integer, Level As Byte, iNumber As String, RefDes As String, Qty As Integer, iDesc As String
>>> With Worksheets("hoja2")
>>> .Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
>>> End With
>>> With Worksheets("hoja1")
>>> For Fila = 2 To .Range("a65536").End(xlUp).Row
>>> Level = .Range("a" & Fila)
>>> iNumber = .Range("b" & Fila)
>>> RefDes = .Range("c" & Fila)
>>> Qty = .Range("d" & Fila)
>>> iDesc = .Range("e" & Fila)
>>> With Worksheets("hoja2")
>>> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
>>> .Offset() = Level
>>> .Offset(, 1) = iNumber
>>> .Offset(, 2) = Application.Transpose(Split(RefDes, ","))
>>> .Offset(, 3) = 1
>>> .Offset(, 4) = iDesc
>>> End With
>>> End With
>>> Next
>>> End With
>>> Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
>>> End Sub
>>>
>>> OJO: la funcion de vba "Split" requiere de VBA6 (excel 2000 en adelante)
>>> si piensas utilizarla en la version 97 de excel (VBA5) deberas proveerla, poniendo al inicio de tu modulo lo siguiente:
>>>
>>> #If Not VBA6 Then
>>> Function Split(Cadena As String, Delimitador As String) As Variant
>>> Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
>>> End Function
>>> #End If
>>>
>>> si cualquier duda (o informacion adicional)... comentas ?
>>> saludos,
>>> hector.
>>>
>>>> En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des, D1-Qty, E1-Item Description.
>>>> En la columna de Ref des tiene la lista de las locaciones existentes de un numero de parte (R1, R2, R3, etc)
>>>> lo que me gustaria hacer es separar esa informacion... que la macro cree otra hoja y acomode la misma informacion
>>>> (apartir del numero de parte de nivel 0) pero con los "REF DES" listados en los renglones correspondientes
>>>> ... si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los ref des con la misma informacion del numero de parte
>>>> el resultado seria mas o menos como una base de datos.
>>>> abajo hice una tabla de ejemplo y otra tabla como me gustaria tener el resultado.
>>>> Pueden tomar estos datos y pegarlos en una hoja de calculo para que tengan mejor vision de la tabla.
>>>>
>>>> OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o tres letras como LED1, LED2;
>>>> Todos los datos estan separados por una coma. Y notese tambien de que no tiene espacios (...)
>>>
>>> << ya sabes que las "tablas" usando espacios y tabulaciones NO "pasan" como quisieras en los lectores de noticias >> :-((



Responder Con Cita
  #6 (permalink)  
Antiguo 08-08-2008, 15:03:01
Manny_90
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

OK. Entonces el macro se va a detener si el valor es nulo o es cero???


mmmmm..(estaria bien que corriera con ceros)...,


ultima pregunta..
Solo un pequeno detalle, hay renglones que tienen 57 y 83 Ref des (267 & 404
caracteres respectivamente) y en el resultado de esos numeros de parte no
lista los REF DES, solo captura #VALUE!. Uso Excel 97.

Ahora, el problema es de que en ocaciones tengo archivos donde contienen mas
de 1000 ref des....

Espero y haya solucion a eso....
Mil gracias










"Héctor Miguel" wrote:

> hola, !
>
> > ... tengo un problema, el macro se para en la linea:
> > With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
> > Ya no avanza y el error que genera es: Run-time error '1004': Aplication defined or object defined error

>
> la variable Qty es tomada por el codigo en esta linea:
> >> > Qty = .Range("d" & Fila)

> lo que supone/espera/asume/requiere/... que en la columna D de la fila "en turno" exista un valor numerico
> que es el numero de "items" que seran trasladados -> previa "ampliacion" del rango por al instruccion .Resize(Qty)
>
> comentas (si hubiera) algun detalle en el tintero ?
> saludos,
> hector.
>
> __ OP __
> >>> el siguiente ejemplo "asume" que ha existe una "Hoja2", OJO que siempre se eliminan sus datos y se reemplazan por la macro:
> >>>
> >>> Sub Lista_partes()
> >>> Dim Fila As Integer, Level As Byte, iNumber As String, RefDes As String, Qty As Integer, iDesc As String
> >>> With Worksheets("hoja2")
> >>> .Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
> >>> End With
> >>> With Worksheets("hoja1")
> >>> For Fila = 2 To .Range("a65536").End(xlUp).Row
> >>> Level = .Range("a" & Fila)
> >>> iNumber = .Range("b" & Fila)
> >>> RefDes = .Range("c" & Fila)
> >>> Qty = .Range("d" & Fila)
> >>> iDesc = .Range("e" & Fila)
> >>> With Worksheets("hoja2")
> >>> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
> >>> .Offset() = Level
> >>> .Offset(, 1) = iNumber
> >>> .Offset(, 2) = Application.Transpose(Split(RefDes, ","))
> >>> .Offset(, 3) = 1
> >>> .Offset(, 4) = iDesc
> >>> End With
> >>> End With
> >>> Next
> >>> End With
> >>> Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
> >>> End Sub
> >>>
> >>> OJO: la funcion de vba "Split" requiere de VBA6 (excel 2000 en adelante)
> >>> si piensas utilizarla en la version 97 de excel (VBA5) deberas proveerla, poniendo al inicio de tu modulo lo siguiente:
> >>>
> >>> #If Not VBA6 Then
> >>> Function Split(Cadena As String, Delimitador As String) As Variant
> >>> Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
> >>> End Function
> >>> #End If
> >>>
> >>> si cualquier duda (o informacion adicional)... comentas ?
> >>> saludos,
> >>> hector.
> >>>
> >>>> En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des, D1-Qty, E1-Item Description.
> >>>> En la columna de Ref des tiene la lista de las locaciones existentes de un numero de parte (R1, R2, R3, etc)
> >>>> lo que me gustaria hacer es separar esa informacion... que la macro cree otra hoja y acomode la misma informacion
> >>>> (apartir del numero de parte de nivel 0) pero con los "REF DES" listados en los renglones correspondientes
> >>>> ... si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los ref des con la misma informacion del numero de parte
> >>>> el resultado seria mas o menos como una base de datos.
> >>>> abajo hice una tabla de ejemplo y otra tabla como me gustaria tener el resultado.
> >>>> Pueden tomar estos datos y pegarlos en una hoja de calculo para que tengan mejor vision de la tabla.
> >>>>
> >>>> OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o tres letras como LED1, LED2;
> >>>> Todos los datos estan separados por una coma. Y notese tambien de que no tiene espacios (...)
> >>>
> >>> << ya sabes que las "tablas" usando espacios y tabulaciones NO "pasan" como quisieras en los lectores de noticias >> :-((

>
>
>

Responder Con Cita
  #7 (permalink)  
Antiguo 08-08-2008, 18:04:33
Héctor Miguel
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

hola, !

> OK. Entonces el macro se va a detener si el valor es nulo o es cero???
> mmmmm..(estaria bien que corriera con ceros)...


"esto" no aparecia como posibilidad en tu consulta original ni lo habias comentado :-((
pero puedes "atrapar" los casos en que no exista cantidad (Qty) +/- como sigue:

1) agrega una linea inmediatamente DESPUES de donde se toma la cantidad:

Qty = .Range("d" & Fila)
If Qty < 1 Then Goto SaltarBucle ' <= esta linea es nueva

2) agrega la "etiqueta" (SaltarBucle) inmediatamente ANTES de la linea con la instruccion "Next"
(solo que necesitas agregar dos_puntos al "nombre" de la etiqueta en esta parte:

SaltarBucle:
Next

> Solo un pequeno detalle, hay renglones que tienen 57 y 83 Ref des (267 & 404 caracteres respectivamente)
> y en el resultado de esos numeros de parte no lista los REF DES, solo captura #VALUE!. Uso Excel 97.
> Ahora, el problema es de que en ocaciones tengo archivos donde contienen mas de 1000 ref des...


supongo que sera algo que tendra que ver con alguna limitante de +/- 255 caracteres "bajo ciertas circunstancias" -???-
podrias transcribir dos o tres ejemplos de este tipo de casos ?

saludos,
hector.

p.d. por la version, no te preocupes, las pruebas las hago desde la version '97

>>> ... tengo un problema, el macro se para en la linea:
>>> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
>>> Ya no avanza y el error que genera es: Run-time error '1004': Aplication defined or object defined error

>>
>> la variable Qty es tomada por el codigo en esta linea:
>>>> > Qty = .Range("d" & Fila)

>> lo que supone/espera/asume/requiere/... que en la columna D de la fila "en turno" exista un valor numerico
>> que es el numero de "items" que seran trasladados -> previa "ampliacion" del rango por al instruccion .Resize(Qty)
>>
>> __ OP __
>>>>> el siguiente ejemplo "asume" que ha existe una "Hoja2", OJO que siempre se eliminan sus datos y se reemplazan por la macro:
>>>>>
>>>>> Sub Lista_partes()
>>>>> Dim Fila As Integer, Level As Byte, iNumber As String, RefDes As String, Qty As Integer, iDesc As String
>>>>> With Worksheets("hoja2")
>>>>> .Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
>>>>> End With
>>>>> With Worksheets("hoja1")
>>>>> For Fila = 2 To .Range("a65536").End(xlUp).Row
>>>>> Level = .Range("a" & Fila)
>>>>> iNumber = .Range("b" & Fila)
>>>>> RefDes = .Range("c" & Fila)
>> >>> Qty = .Range("d" & Fila)
>>>> iDesc = .Range("e" & Fila)
>>>>> With Worksheets("hoja2")
>>>>> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
>>>>> .Offset() = Level
>>>>> .Offset(, 1) = iNumber
>>>>> .Offset(, 2) = Application.Transpose(Split(RefDes, ","))
>>>>> .Offset(, 3) = 1
>>>>> .Offset(, 4) = iDesc
>>>>> End With
>>>>> End With
>>>>> Next
>>>>> End With
>>>>> Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
>>>>> End Sub
>>>>>
>>>>> OJO: la funcion de vba "Split" requiere de VBA6 (excel 2000 en adelante)
>>>>> si piensas utilizarla en la version 97 de excel (VBA5) deberas proveerla, poniendo al inicio de tu modulo lo siguiente:
>>>>>
>>>>> #If Not VBA6 Then
>>>>> Function Split(Cadena As String, Delimitador As String) As Variant
>>>>> Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
>>>>> End Function
>>>>> #End If
>>>>>
>>>>>> En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des, D1-Qty, E1-Item Description.
>>>>>> En la columna de Ref des tiene la lista de las locaciones existentes de un numero de parte (R1, R2, R3, etc)
>>>>>> lo que me gustaria hacer es separar esa informacion... que la macro cree otra hoja y acomode la misma informacion
>>>>>> (apartir del numero de parte de nivel 0) pero con los "REF DES" listados en los renglones correspondientes
>>>>>> ... si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los ref des con la misma informacion del numero de parte
>>>>>> el resultado seria mas o menos como una base de datos.
>>>>>> abajo hice una tabla de ejemplo y otra tabla como me gustaria tener el resultado.
>>>>>> Pueden tomar estos datos y pegarlos en una hoja de calculo para que tengan mejor vision de la tabla.
>>>>>>
>>>>>> OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o tres letras como LED1, LED2;
>>>>>> Todos los datos estan separados por una coma. Y notese tambien de que no tiene espacios (...)
>>>>>
>>>>> << ya sabes que las "tablas" usando espacios y tabulaciones NO "pasan" como quisieras en los lectores de noticias >> :-((



Responder Con Cita
  #8 (permalink)  
Antiguo 08-08-2008, 21:07:03
Manny_90
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

Este es un ejemplo donde hay en una celda mas de 255 caracteres...
Tengo mas de 700 referencias y no las separa, solo separa los numeros de
parte y en el campo de ref des tiene VALUE#!




Level Item Number Ref Des Qty Item Description
4 CAPSM-0000000109-522 C14,C15,C25,C26,C99,C113,C114,C115,C116,C117,C118, C130,C131,C132,C133,C154,C155,C156,C163,C164,C171, C181,C182,C183,C184,C185,C186,C223,C224,C225,C226, C227,C228,C245,C246,C247,C248,C249,C250,C269,C270, C271,C272,C273,C274,C275,C276,C493,C494,C495,C496, C497,C498,C499,C500,C501,C502,C503,C504,C505,C506, C507,C508,C509,C510,C511,C512,C513,C514,C515,C516, C517,C518,C519,C520,C521,C522,C523,C524,C527,C528, C529,C530,C531,C532,C533,C534,C535,C536,C537,C538, C539,C540,C541,C542,C543,C544,C545,C546,C547,C548, C549,C550,C551,C552,C553,C554,C555,C556,C557,C558, C563,C564,C574,C576,C582,C583,C584,C619,C620,C621, C622,C623,C627,C628,C629,C630,C631,C632,C650,C677, C678,C679,C680,C685,C686,C687,C688,C689,C690,C691, C692,C693,C715,C716,C717,C718,C719,C720,C721,C722, C723,C724,C725,C726,C727,C728,C729,C730,C731,C732, C733,C734,C735,C736,C737,C738,C739,C740,C741,C742, C743,C744,C745,C746,C750,C751,C752,C753,C754,C755, C756,C757,C758,C759,C760,C761,C762,C763,C764,C765, C766,C767,C768,C769,C770,C771,C772,C773,C774,C775, C776,C777,C778,C779,C780,C781,C851,C852,C853,C854, C855,C856,C873,C908,C909,C910,C911,C912,C913,C914, C915,C916,C919,C938,C939,C940,C941,C942,C943,C944, C945,C946,C947,C948,C949,C950,C951,C952,C953,C954, C955,C956,C957,C958,C959,C960,C961,C962,C963,C964, C965,C966,C967,C968,C969,C970,C971,C972,C973,C974, C975,C976,C977,C978,C979,C980,C981,C982,C983,C984, C985,C986,C987,C988,C989,C990,C991,C992,C993,C996, C997,C998,C999,C1000,C1001,C1002,C1003,C1004,C1005 ,C1006,C1007,C1008,C1009,C1010,C1011,C1012,C1013,C 1014,C1015,C1016,C1017,C1018,C1019,C1020,C1021,C10 22,C1023,C1024,C1025,C1026,C1027,C1028,C1029,C1030 ,C1031,C1032,C1033,C1034,C1035,C1036,C1037,C1038,C 1039,C1040,C1041,C1042,C1043,C1044,C1045,C1046,C10 47,C1048,C1049,C1050,C1051,C1198,C1199,C1200,C1201 ,C1202,C1203,C1204,C1205,C1206,C1207,C1208,C1209,C 1210,C1211,C1212,C1213,C1214,C1215,C1216,C1217,C12 18,C1219,C1220,C1221,C1222,C1223,C1224,C1225,C1226 ,C1227,C1228,C1229,C1230,C1231,C1232,C1233,C1234,C 1235,C1236,C1237,C1238,C1239,C1240,C1241,C1242,C12 43,C1244,C1245,C1246,C1247,C1248,C1249,C1250,C1251 ,C1252,C1253,C1393,C1394,C1395,C1396,C1397,C1398,C 2198,C2199,C2201,C2202,C2258,C2259,C2260,C2261,C22 64,C2265,C2291,C2302,C2303,C2308,C2310,C2311,C2316 ,C2322,C2330,C2338,C2339,C2344,C2351,C2356,C2357,C 2358,C2363,C2382,C2390,C2479,C2480,C2481,C2482,C24 83,C2484,C2485,C2486,C2500,C2523,C2524,C2525,C2526 ,C2527,C2528,C2529,C2530,C2531,C2532,C2554,C2555,C 2557,C2558,C2559,C2560,C2561,C2562,C2589,C2590,C26 06,C2607,C2608,C2627,C2628,C2629,C2630,C2631,C3011 ,C3012,C3013,C3014,C3015,C3016 470 CAP
..1UF CM 16V 10% X5R 0402
4 CAPSM-0000000113-522 C27,C28,C30,C36,C38,C39,C40,C41,C42,C43,C44,C45,C4 6,C48,C92,C107,C108,C109,C110,C111,C112,C119,C134, C135,C136,C137,C151,C152,C153,C165,C166,C172,C187, C188,C189,C190,C191,C192,C217,C218,C219,C220,C221, C222,C251,C252,C253,C254,C255,C256,C487,C488,C492, C561,C562,C569,C571,C575,C577,C578,C585,C586,C605, C606,C607,C608,C609,C611,C612,C613,C614,C615,C616, C625,C639,C649,C664,C665,C666,C667,C668,C669,C670, C671,C672,C673,C674,C675,C676,C694,C695,C696,C697, C747,C784,C785,C793,C795,C796,C799,C802,C809,C810, C820,C829,C830,C831,C832,C836,C837,C838,C839,C840, C841,C849,C862,C872,C887,C888,C889,C890,C891,C892, C893,C894,C895,C896,C897,C898,C899,C917,C918,C920, C1054,C1055,C1062,C1064,C1066,C1075,C1076,C1077,C1 078,C1097,C1098,C1099,C1100,C1101,C1104,C1105,C110 6,C1107,C1108,C1109,C1117,C1131,C1141,C1153,C1154, C1155,C1156,C1157,C1158,C1159,C1160,C1161,C1162,C1 163,C1164,C1169,C1170,C1171,C1172,C1182,C1327,C132 8,C1336,C1337,C1338,C1339,C1351,C1352,C1353,C1363, C1372,C1373,C1374,C1378,C1379,C1380,C1381,C1382,C1 383,C1400,C1405,C1415,C1427,C1428,C1429,C1430,C143 1,C1432,C1433,C1434,C1435,C1436,C1437,C1438,C1439, C1440,C1441,C1442,C1460,C2346,C2347,C2348,C2349,C2 361,C2362,C2365,C2391,C2471,C2472,C2473,C2474,C247 5,C2476,C2477,C2478,C2511,C2513,C2514,C2515,C2516, C2517,C2518,C2519,C2520,C2521,C2522,C2563,C2564,C2 566,C2567,C2568,C2569,C2570,C2571,C2591,C2592,C260 3,C2604,C2605,C2622,C2623,C2624,C2625,C2626,C2632, C2633,C2634,C2635,C2636,C2657,C2658,C2659,C2661,C2 682,C2701,C2702,C2703,C2705,C2726,C2745,C2746,C274 7,C2749,C2792,C2814,C2838,C2839,C2840,C2842,C2880, C2901,C2944,C2945,C2946,C2947,C2948,C2949,C2950,C2 951,C2952,C2953,C2954,C2955 296 CAP .22UF CM 10V 10% X5R 0402
4 CAPSM-0000000004-522 C21,C22,C23,C50,C51,C52,C53,C55,C56,C57,C58,C59,C6 0,C61,C62,C63,C64,C65,C66,C67,C68,C82,C84,C86,C88, C90,C278,C279,C280,C281,C282,C283,C284,C285,C286,C 287,C288,C289,C290,C291,C294,C295,C296,C297,C298,C 299,C300,C301,C302,C303,C304,C305,C306,C307,C322,C 327,C340,C345,C786,C787,C798,C800,C801,C806,C807,C 833,C843,C844,C845,C846,C900,C901,C902,C903,C1056, C1057,C1065,C1072,C1073,C1074,C1083,C1111,C1112,C1 113,C1114,C1115,C1119,C1120,C1121,C1122,C1123,C112 4,C1142,C1165,C1173,C1174,C1175,C1176,C1177,C1178, C1179,C1180,C1181,C1259,C1262,C1264,C1329,C1330,C1 340,C1341,C1342,C1347,C1348,C1375,C1376,C1386,C138 7,C1388,C1389,C1443,C1451,C1452,C1453,C1454,C1455, C1456,C1457,C1458,C1459,C1478,C1479,C1480,C1481,C1 482,C1483,C1490,C1491,C1492,C1493,C1494,C1495,C152 3,C1524,C1525,C1526,C1527,C1528,C1529,C1530,C1531, C1532,C1533,C1534,C1535,C1536,C1537,C1538,C1539,C1 540,C1541,C1542,C1543,C1544,C1545,C1546,C1547,C154 8,C1549,C1550,C1551,C1552,C1553,C1554,C1555,C1556, C1557,C1558,C1559,C1560,C1561,C1562,C1563,C1564,C1 565,C1566,C1567,C1568,C1569,C1570,C1571,C1572,C157 3,C1574,C1575,C1576,C1577,C1578,C1579,C1580,C1581, C1582,C1583,C1584,C1585,C1586,C1587,C1588,C1589,C1 590,C1591,C1592,C1593,C1594,C1595,C1596,C1597,C159 8,C1599,C1600,C1601,C1602,C1603,C1604,C1605,C1606, C1607,C1608,C1609,C1610,C1611,C1612,C1613,C1614,C1 615,C1616,C1617,C1618,C1619,C1620,C1621,C1622,C162 3,C1624,C1625,C1626,C1627,C1628,C1629,C1630,C1631, C1632,C1633,C1634,C1635,C1636,C1637,C1638,C1639,C1 640,C1641,C1642,C1643,C1644,C1645,C1646,C1647,C164 8,C1649,C1650,C1651,C1652,C1653,C1654,C1655,C1656, C1657,C1658,C1659,C1660,C1661,C1662,C1663,C1664,C1 665,C1666,C1667,C1668,C1669,C1670,C1671,C1672,C167 3,C1674,C1675,C1676,C1677,C1678,C1679,C1680,C1681, C1682,C1683,C1684,C1685,C1686,C1687,C1688,C1689,C1 690,C1691,C1692,C1693,C1694,C1695,C1696,C1697,C169 8,C1699,C1700,C1701,C1702,C1703,C1704,C1705,C1706, C1707,C1708,C1709,C1710,C1711,C1712,C1713,C1714,C1 715,C1716,C1717,C1718,C1719,C1720,C1721,C1722,C172 3,C1724,C1725,C1726,C1727,C1728,C1729,C1730,C1731, C1732,C1733,C1734,C1735,C1736,C1737,C1738,C1739,C1 740,C1741,C1742,C1743,C1744,C1745,C1746,C1747,C174 8,C1749,C1750,C1751,C1752,C1753,C1754,C1755,C1756, C1757,C1758,C1759,C1760,C1761,C1762,C1765,C1772,C1 773,C1774,C1775,C1776,C1777,C1779,C1780,C1781,C178 2,C1783,C1784,C1785,C1786,C1787,C1788,C1789,C1790, C1791,C1792,C1793,C1794,C1795,C1798,C1805,C1806,C1 807,C1808,C1809,C1810,C1812,C1813,C1814,C1815,C181 6,C1817,C1818,C1819,C1820,C1821,C1822,C1823,C1824, C1825,C1826,C1827,C1828,C1831,C1838,C1839,C1840,C1 841,C1842,C1843,C1845,C1846,C1847,C1848,C1849,C185 0,C1851,C1852,C1853,C1854,C1855,C1856,C1857,C1858, C1859,C1860,C1861,C1864,C1871,C1872,C1873,C1874,C1 875,C1876,C1878,C1879,C1880,C1881,C1882,C1883,C188 4,C1885,C1886,C1887,C1888,C1889,C1890,C1891,C1892, C1893,C1894,C1897,C1904,C1905,C1906,C1907,C1908,C1 909,C1911,C1912,C1913,C1914,C1915,C1916,C1917,C191 8,C1919,C1920,C1921,C1922,C1923,C1924,C1925,C1926, C1927,C1930,C1937,C1938,C1939,C1940,C1941,C1942,C1 944,C1945,C1946,C1947,C1948,C1949,C1950,C1951,C195 2,C1953,C1954,C1955,C1956,C1957,C1958,C1959,C1960, C1963,C1970,C1971,C1972,C1973,C1974,C1975,C1977,C1 978,C1979,C1980,C1981,C1982,C1983,C1984,C1985,C198 6,C1987,C1988,C1989,C1990,C1991,C1992,C1993,C1996, C2003,C2004,C2005,C2006,C2007,C2008,C2010,C2011,C2 012,C2013,C2014,C2015,C2016,C2017,C2018,C2019,C202 0,C2021,C2022,C2023,C2024,C2025,C2026,C2029,C2036, C2037,C2038,C2039,C2040,C2041,C2043,C2044,C2045,C2 046,C2047,C2048,C2049,C2050,C2051,C2052,C2053,C205 4,C2055,C2056,C2057,C2058,C2059,C2062,C2069,C2070, C2071,C2072,C2073,C2074,C2076,C2077,C2078,C2079,C2 080,C2081,C2082,C2083,C2084,C2085,C2086,C2087,C208 8,C2089,C2090,C2091,C2092,C2095,C2102,C2103,C2104, C2105,C2106,C2107,C2109,C2110,C2111,C2112,C2113,C2 114,C2115,C2116,C2117,C2118,C2119,C2120,C2121,C212 2,C2123,C2124,C2125,C2128,C2135,C2136,C2137,C2138, C2139,C2140,C2142,C2143,C2144,C2145,C2146,C2147,C2 148,C2149,C2150,C2151,C2152,C2153,C2154,C2155,C215 6,C2157,C2158,C2413,C2414,C2415,C2416,C2417,C2418, C2419,C2420,C2421,C2422,C2423,C2424,C2425,C2426,C2 427,C2428,C2429,C2430,C2431,C2432,C2433,C2434,C243 5,C2436,C2437,C2438,C2439,C2440,C2441,C2442,C2443, C2444,C2445,C2446,C2447,C2448,C2449,C2450,C2451,C2 452,C2453,C2454,C2666,C2710,C2759,C2776,C2857,C285 8,C2859,C2860,C2861,C2864,C2881,C2882,C2883,C2884, C2885,C2886,C2887,C2978,C2979,C2980,C2981,C2982,C2 983 734 CAP .1UF CM 100V 10% X5R 0402
4 CAPSM-0000000100-522 C18,C19,C29,C31,C49,C106,C120,C121,C122,C123,C124, C125,C126,C127,C128,C129,C157,C158,C159,C161,C162, C170,C174,C175,C176,C177,C178,C179,C229,C230,C231, C232,C233,C234,C239,C240,C241,C242,C243,C244,C328, C330,C346,C348,C566,C568,C588,C590,C591,C634,C635, C636,C637,C638,C641,C642,C643,C644,C645,C646,C660, C661,C662,C663,C698,C699,C700,C701,C702,C703,C704, C705,C706,C788,C790,C808,C812,C813,C847,C858,C859, C860,C861,C864,C865,C866,C867,C868,C869,C883,C884, C885,C886,C921,C922,C923,C924,C925,C926,C927,C928, C929,C1058,C1060,C1080,C1081,C1082,C1126,C1127,C11 28,C1129,C1130,C1133,C1134,C1135,C1136,C1137,C1138 ,C1152,C1187,C1188,C1189,C1190,C1191,C1192,C1193,C 1194,C1195,C1263,C1265,C1331,C1349,C1350,C1355,C13 56,C1390,C1401,C1402,C1403,C1404,C1407,C1408,C1409 ,C1410,C1411,C1412,C1416,C1426,C1461,C1462,C1463,C 1464,C1465,C1466,C1467,C1468,C1469,C1472,C1473,C14 74,C1475,C1476,C1477,C1484,C1485,C1486,C1487,C1488 ,C1489,C1496,C1498,C1499,C1500,C1506,C1507,C1508,C 1509,C1512,C1513,C1514,C2164,C2165,C2166,C2167,C21 68,C2169,C2172,C2174,C2175,C2176,C2181,C2182,C2183 ,C2184,C2185,C2186,C2188,C2194,C2195,C2203,C2204,C 2205,C2206,C2207,C2208,C2209,C2210,C2214,C2217,C22 19,C2222,C2224,C2226,C2227,C2237,C2238,C2240,C2242 ,C2243,C2245,C2246,C2247,C2367,C2368,C2370,C2378,C 2383,C2488,C2492,C2493,C2494,C2495,C2496,C2497,C24 98,C2512,C2533,C2534,C2535,C2536,C2537,C2538,C2539 ,C2540,C2541,C2542,C2545,C2546,C2548,C2549,C2550,C 2551,C2552,C2553,C2581,C2582,C2609,C2610,C2611,C26 17,C2618,C2619,C2620,C2621,C2660,C2662,C2663,C2664 ,C2665,C2668,C2669,C2670,C2671,C2672,C2673,C2674,C 2675,C2704,C2706,C2707,C2708,C2709,C2712,C2713,C27 14,C2715,C2716,C2717,C2718,C2719,C2748,C2750,C2751 ,C2752,C2753,C2766,C2770,C2772,C2773,C2774,C2775,C 2778,C2779,C2780,C2781,C2782,C2783,C2784,C2785,C28 01,C2802,C2803,C2804,C2805,C2806,C2807,C2841,C2848 ,C2849,C2850,C2851,C2863,C2866,C2867,C2868,C2869,C 2870,C2871,C2872,C2873,C2911 331 CAP .047UF CM 10V 10% X7R 0402
4 CAPSM-0000000092-522 C32,C33,C34,C35,C37,C47,C93,C94,C95,C96,C97,C98,C1 42,C143,C144,C145,C146,C147,C148,C180,C199,C200,C2 01,C202,C203,C204,C205,C206,C207,C208,C209,C210,C2 36,C238,C263,C264,C265,C266,C267,C268,C321,C323,C3 39,C341,C573,C579,C580,C581,C587,C589,C597,C604,C6 10,C617,C618,C624,C626,C633,C640,C647,C681,C682,C6 83,C684,C711,C712,C713,C714,C797,C803,C804,C805,C8 11,C814,C821,C828,C834,C835,C842,C848,C850,C857,C8 63,C870,C904,C905,C906,C907,C934,C935,C936,C937,C1 068,C1069,C1070,C1071,C1079,C1087,C1089,C1096,C110 2,C1103,C1110,C1116,C1118,C1125,C1132,C1139,C1166, C1167,C1168,C1183,C1184,C1185,C1186,C1197,C1258,C1 260,C1343,C1344,C1345,C1346,C1354,C1357,C1364,C137 1,C1377,C1384,C1385,C1391,C1392,C1399,C1406,C1413, C1444,C1445,C1446,C1447,C1448,C1449,C1450,C1471,C1 769,C1771,C1802,C1804,C1835,C1837,C1868,C1870,C190 1,C1903,C1934,C1936,C1967,C1969,C2000,C2002,C2033, C2035,C2066,C2068,C2099,C2101,C2132,C2134,C2333,C2 334,C2335,C2336,C2359,C2387,C2401,C2402,C2403,C240 4,C2405,C2406,C2407,C2408,C2409,C2410,C2411,C2412, C2455,C2456,C2457,C2458,C2459,C2460,C2461,C2462,C2 487,C2489,C2490,C2491,C2547,C2556,C2565,C2574,C258 3,C2584,C2585,C2586,C2587,C2588,C2595,C2596,C2597, C2598,C2599,C2642,C2643,C2644,C2645,C2646,C2647,C2 648,C2649,C2650,C2651,C2683,C2684,C2685,C2686,C268 7,C2688,C2690,C2691,C2692,C2693,C2694,C2695,C2727, C2728,C2729,C2730,C2731,C2732,C2734,C2735,C2736,C2 737,C2738,C2739,C2754,C2755,C2756,C2757,C2758,C279 3,C2794,C2795,C2796,C2797,C2798,C2800,C2815,C2816, C2817,C2818,C2819,C2820,C2822,C2823,C2824,C2825,C2 826,C2827,C2833,C2834,C2835,C2836,C2837,C2888,C288 9,C2890,C2891,C2892,C2893,C2902,C2903,C2904,C2905, C2906,C2907,C2908,C2910,C2984,C2985,C2986,C2987,C2 988,C2989 294 CAP
22UF CM 6.3V 20% X5R 0805
4 CAPSM-0000000104-522 C12,C13,C376,C377,C378,C379,C380,C381,C382,C409,C4 10,C437,C438,C465,C466,C1763,C1764,C1766,C1767,C17 68,C1770,C1778,C1796,C1797,C1799,C1800,C1801,C1803 ,C1811,C1829,C1830,C1832,C1833,C1834,C1836,C1844,C 1862,C1863,C1865,C1866,C1867,C1869,C1877,C1895,C18 96,C1898,C1899,C1900,C1902,C1910,C1928,C1929,C1931 ,C1932,C1933,C1935,C1943,C1961,C1962,C1964,C1965,C 1966,C1968,C1976,C1994,C1995,C1997,C1998,C1999,C20 01,C2009,C2027,C2028,C2030,C2031,C2032,C2034,C2042 ,C2060,C2061,C2063,C2064,C2065,C2067,C2075,C2093,C 2094,C2096,C2097,C2098,C2100,C2108,C2126,C2127,C21 29,C2130,C2131,C2133,C2141,C2196,C2197,C2228,C2229 ,C2244,C3009 105 CAP 10UF CM 6.3V 20% X5R 0603















"Héctor Miguel" wrote:

> hola, !
>
> > OK. Entonces el macro se va a detener si el valor es nulo o es cero???
> > mmmmm..(estaria bien que corriera con ceros)...

>
> "esto" no aparecia como posibilidad en tu consulta original ni lo habias comentado :-((
> pero puedes "atrapar" los casos en que no exista cantidad (Qty) +/- como sigue:
>
> 1) agrega una linea inmediatamente DESPUES de donde se toma la cantidad:
>
> Qty = .Range("d" & Fila)
> If Qty < 1 Then Goto SaltarBucle ' <= esta linea es nueva
>
> 2) agrega la "etiqueta" (SaltarBucle) inmediatamente ANTES de la linea con la instruccion "Next"
> (solo que necesitas agregar dos_puntos al "nombre" de la etiqueta en esta parte:
>
> SaltarBucle:
> Next
>
> > Solo un pequeno detalle, hay renglones que tienen 57 y 83 Ref des (267 & 404 caracteres respectivamente)
> > y en el resultado de esos numeros de parte no lista los REF DES, solo captura #VALUE!. Uso Excel 97.
> > Ahora, el problema es de que en ocaciones tengo archivos donde contienen mas de 1000 ref des...

>
> supongo que sera algo que tendra que ver con alguna limitante de +/- 255 caracteres "bajo ciertas circunstancias" -???-
> podrias transcribir dos o tres ejemplos de este tipo de casos ?
>
> saludos,
> hector.
>
> p.d. por la version, no te preocupes, las pruebas las hago desde la version '97
>
> >>> ... tengo un problema, el macro se para en la linea:
> >>> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
> >>> Ya no avanza y el error que genera es: Run-time error '1004': Aplication defined or object defined error
> >>
> >> la variable Qty es tomada por el codigo en esta linea:
> >>>> > Qty = .Range("d" & Fila)
> >> lo que supone/espera/asume/requiere/... que en la columna D de la fila "en turno" exista un valor numerico
> >> que es el numero de "items" que seran trasladados -> previa "ampliacion" del rango por al instruccion .Resize(Qty)
> >>
> >> __ OP __
> >>>>> el siguiente ejemplo "asume" que ha existe una "Hoja2", OJO que siempre se eliminan sus datos y se reemplazan por la macro:
> >>>>>
> >>>>> Sub Lista_partes()
> >>>>> Dim Fila As Integer, Level As Byte, iNumber As String, RefDes As String, Qty As Integer, iDesc As String
> >>>>> With Worksheets("hoja2")
> >>>>> .Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
> >>>>> End With
> >>>>> With Worksheets("hoja1")
> >>>>> For Fila = 2 To .Range("a65536").End(xlUp).Row
> >>>>> Level = .Range("a" & Fila)
> >>>>> iNumber = .Range("b" & Fila)
> >>>>> RefDes = .Range("c" & Fila)
> >> >>> Qty = .Range("d" & Fila)
> >>>> iDesc = .Range("e" & Fila)
> >>>>> With Worksheets("hoja2")
> >>>>> With .Range("a65536").End(xlUp).Offset(1).Resize(Qty)
> >>>>> .Offset() = Level
> >>>>> .Offset(, 1) = iNumber
> >>>>> .Offset(, 2) = Application.Transpose(Split(RefDes, ","))
> >>>>> .Offset(, 3) = 1
> >>>>> .Offset(, 4) = iDesc
> >>>>> End With
> >>>>> End With
> >>>>> Next
> >>>>> End With
> >>>>> Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
> >>>>> End Sub
> >>>>>
> >>>>> OJO: la funcion de vba "Split" requiere de VBA6 (excel 2000 en adelante)
> >>>>> si piensas utilizarla en la version 97 de excel (VBA5) deberas proveerla, poniendo al inicio de tu modulo lo siguiente:
> >>>>>
> >>>>> #If Not VBA6 Then
> >>>>> Function Split(Cadena As String, Delimitador As String) As Variant
> >>>>> Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
> >>>>> End Function
> >>>>> #End If
> >>>>>
> >>>>>> En la hoja 1 tengo esta informacion A1-LEVEL, B1-Item Number, C1-Ref Des, D1-Qty, E1-Item Description.
> >>>>>> En la columna de Ref des tiene la lista de las locaciones existentes de un numero de parte (R1, R2, R3, etc)
> >>>>>> lo que me gustaria hacer es separar esa informacion... que la macro cree otra hoja y acomode la misma informacion
> >>>>>> (apartir del numero de parte de nivel 0) pero con los "REF DES" listados en los renglones correspondientes
> >>>>>> ... si son 10 ref des, que en la otra tabla agregue 10 renglones y acomode los ref des con la misma informacion del numero de parte
> >>>>>> el resultado seria mas o menos como una base de datos.
> >>>>>> abajo hice una tabla de ejemplo y otra tabla como me gustaria tener el resultado.
> >>>>>> Pueden tomar estos datos y pegarlos en una hoja de calculo para que tengan mejor vision de la tabla.
> >>>>>>
> >>>>>> OJO. Los Ref des pueden ser de diferentes letras como C, Q, L, incluso dos o tres letras como LED1, LED2;
> >>>>>> Todos los datos estan separados por una coma. Y notese tambien de que no tiene espacios (...)
> >>>>>
> >>>>> << ya sabes que las "tablas" usando espacios y tabulaciones NO "pasan" como quisieras en los lectores de noticias >> :-((

>
>
>

Responder Con Cita
  #9 (permalink)  
Antiguo 09-08-2008, 09:04:57
Héctor Miguel
 
Mensajes: n/a
Predeterminado Re: Macro para acomodar datos

hola, !

> Este es un ejemplo donde hay en una celda mas de 255 caracteres...
> Tengo mas de 700 referencias y no las separa, solo separa los numeros de parte y en el campo de ref des tiene VALUE#! (...)


(menudo "despepite" te cargas con ese archivo) )
haciendo pruebas en la version '97, resulta que un "parametro" +/- aceptable es NO MAS de 175 caracteres
para que vba pueda "tomar" cadenas de texto que pueda convertir en matrices con la funcion "Split" (version '97)
ademas de uno que otro "inconveniente" que encontre en pruebas +/- "severas" que (al final de cuentas) resultan en lo siguiente:

nota: no he puesto la condicionante para cuando en la columna de "Qty" tengas valores "nulos" o en cero :-((
(pero creo que podras adaptar las sugerencias de la propuesta anterior)
tambien puse una "constante" por si necesitas modificar el "separador" (que actualmente es una coma)

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

copia/pega TODO lo siguiente en sustitucion de las propuestas anteriores (en un solo modulo de codigo)

Private Const Limite As Integer = 175
Private Const Separa As String = ","

#If Not VBA6 Then
Function Split(Cadena As String, Delimitador As String) As Variant
Split = Evaluate("{""" & Application.Substitute(Cadena, Delimitador, """,""") & """}")
End Function
Function InStrRev(ByVal Cadena As String, ByVal Caracter As String) As Long
Dim Pos As Integer: InStrRev = 0: If Len(Caracter) <> 1 Then Exit Function
For Pos = Len(Cadena) To 1 Step -1
If Mid(Cadena, Pos, 1) = Caracter Then InStrRev = Pos: Exit Function
Next
End Function
#End If

Sub Lista_partes()
Dim Fila As Integer, Level As Byte, iNumber As String, RefDes, Qty As Integer, iDesc As String, _
Largo As Integer, Multiple As Boolean, Cadena As String, Inicio As Integer, Pos As Integer, xFila As Long
With Worksheets("hoja2")
.Cells.Clear: .Range("a1:e1") = Array("Level", "Item Number", "Ref Des", "Qty", "Item Description")
End With
With Worksheets("hoja1")
For Fila = 2 To .Range("a65536").End(xlUp).Row
Level = .Range("a" & Fila)
iNumber = .Range("b" & Fila)
With .Range("c" & Fila): Largo = Len(.Value): Multiple = Largo > Limite
If Multiple Then Cadena = .Value & Separa Else RefDes = Split(.Value, Separa)
End With
Qty = .Range("d" & Fila)
iDesc = .Range("e" & Fila)
With Worksheets("hoja2")
xFila = .Cells.Find("*", .Cells(1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1
With .Range("a" & xFila).Resize(Qty)
.Offset() = Level
.Offset(, 1) = iNumber
If Not Multiple Then .Offset(, 2) = Application.Transpose(RefDes): GoTo SaltaMultiple
Inicio = 1
Do
Pos = InStrRev(Mid(Cadena, Inicio, Limite), Separa)
RefDes = Split(Mid(Cadena, Inicio, Pos - 1), Separa)
.Parent.Range("c" & xFila).Resize(UBound(RefDes)) = Application.Transpose(RefDes)
xFila = .Parent.Range("c65536").End(xlUp).Row + 1
Inicio = Inicio + Pos
Loop While Inicio < Largo
SaltaMultiple:
.Offset(, 3) = 1
.Offset(, 4) = iDesc
End With
End With
Next
End With
Worksheets("hoja2").Range("a1:e1").EntireColumn.Au toFit
End Sub


Responder Con Cita
 
Respuesta


Herramientas
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Trackbacks are habilitado
Pingbacks are habilitado
Refbacks are habilitado


Temas Similares
Tema Autor Foro Respuestas Último mensaje
Macro para traer datos desde un CVS a un libro Excel colmenaf@gmail.com Newsgroup microsoft.public.es.excel 16 01-09-2008 15:56:06
Macro para Descargar Datos de Internet PaquitoF Newsgroup microsoft.public.es.access 0 27-12-2007 10:55:00
Macro para busqueda de datos jhonyagami Newsgroup microsoft.public.es.excel 3 20-12-2007 13:53:11
Macro VBA Power Point que genere datos y graficos para poblar una LZ Newsgroup microsoft.public.es.powerpoint 12 28-10-2007 12:30:50
Acomodar Papel en Matricial Baldini Newsgroup es.comp.lenguajes.visual-basic 48 24-05-2006 13:48:57





Powered by: vBulletin, Versión 3.6.8
Derechos de Autor ©2000 - 2008, Jelsoft Enterprises Ltd.

LinkBacks Enabled by vBSEO 3.1.0 © 2007, Crawlability, Inc.