Excel - PROCESO LENTO

   
Vista:

PROCESO LENTO

Publicado por catita zarate (11 intervenciones) el 26/03/2009 04:02:25
hola Santiago

tiene el mismo tiempo de ejecucion,pero no voy a insistir mas
porque igual ahorre bastante tiempo y estoy conforme y agradecida.
como resumen les puedo decir, con el codigo inicial me demoraba como 3 minutos y con la ayuda de ustedes sobre todo con la modificacion del codigo de JuanC , ahora me demora como 40 segundos.
el registro que manejo son de aprox.. 3500 filas(3.6.6) donde busco y 165 filas(STOCK & DEMANDA) los codigos que busco

hasta pronto graciaaaas.......

Atte.

Catita Zarate
nota: les mando el codigo para quien le pueda servir

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim filaQ%, filaP%, SUM&, filaX%, old&, sVal$

With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With

Set ws1 = Worksheets("STOCK & DEMANDA")
Set ws2 = Worksheets("3.6.6")

ws1.Range("D6:AF180").Value = Empty

filaX = 6
With ws2
While ws1.Cells(filaX, 1).Value <> ""
SUM = 0
filaQ = 7
While .Cells(filaQ, 16).Value <> ""
sVal = .Cells(filaQ, 15).Value
If .Cells(filaQ, 14).Value = "101" And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
If sVal = "ptre02" Or sVal = "ref53" Or sVal = "ptuh01" Or sVal = "aba" Or sVal = "ref01" Or sVal = "ref" Or sVal = "ref02" Or sVal = "aa0101" Or sVal = "ref1387" Or sVal = "ba0101" Or sVal = "a0101" Or sVal = "c0101" Or sVal = "a9901" Or sVal = "b4001" Then
SUM = SUM + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 5).Value = SUM
End If
End If
filaQ = filaQ + 1
Wend
filaX = filaX + 1
Wend
End With

With Application
.ScreenUpdating = True
.Calculation = old
.EnableEvents = True
End With

Set ws1 = Nothing
Set ws2 = Nothing

End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

RE:PROCESO LENTO

Publicado por catita zarate (11 intervenciones) el 27/03/2009 02:18:02
Amigos:

le agrege mas condiciones de busqueda al codigo ¿porque vuelve a aumentar el tiempo(2 minutos) la demora del proceso a medida que le agrego mas condiciones, si estoy aprovechando el mismo bucle? . les envio el codigo con las condiciones agregadas.

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim filaQ%, filaP%, SUM&, filaX%, old&, sVal$, SUMA&, SUMAR&, SUMARSE&, SUMARSE1&, SUMARSE2&
Dim SUMARSE3&

With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set ws1 = Worksheets("STOCK & DEMANDA")
Set ws2 = Worksheets("3.6.6")

ws1.Range("D6:AF180").Value = Empty
filaX = 6
With ws2
While ws1.Cells(filaX, 1).Value <> ""
SUM = 0
SUMA = 0
SUMAR = 0
SUMARSE = 0
SUMARSE1 = 0
SUMARSE2 = 0
SUMARSE3 = 0
filaQ = 7
While ws2.Cells(filaQ, 16).Value <> ""
sVal = .Cells(filaQ, 15).Value
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

If .Cells(filaQ, 14).Value = "101" And (sVal = "ptre02" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUM = SUM + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 5).Value = SUM
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

ElseIf .Cells(filaQ, 14).Value = "100" And sVal = "cccc01" _
And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMA = SUMA + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 7).Value = SUMA
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

ElseIf .Cells(filaQ, 14).Value = "200" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR = SUMAR + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 8).Value = SUMAR
'ÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇ

ElseIf .Cells(filaQ, 14).Value = "200" And _
sVal = "101->200" And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE = SUMARSE + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 12).Value = SUMARSE
'""""""""""""""""""""""""""""""""""""""

ElseIf .Cells(filaQ, 14).Value = "300" And _
(sVal = "101->300" Or sVal = "200->300") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE1 = SUMARSE1 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 17).Value = SUMARSE1
'¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡

ElseIf .Cells(filaQ, 14).Value = "400" And _
(sVal = "101->400" Or sVal = "200->400") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE2 = SUMARSE2 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 22).Value = SUMARSE2
'¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿

ElseIf .Cells(filaQ, 14).Value = "500" And _
(sVal = "101->500" Or sVal = "200->500") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE3 = SUMARSE3 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 27).Value = SUMARSE3
End If
filaQ = filaQ + 1
Wend
filaX = filaX + 1
Wend
End With

With Application
.ScreenUpdating = True
.Calculation = old
.EnableEvents = True
End With

Set ws1 = Nothing
Set ws2 = Nothing

End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:PROCESO LENTO

Publicado por Santiago (193 intervenciones) el 27/03/2009 04:16:23
Hola, puedes poner tus archivos en algun enlace en internet para que los programadores puedan hacer y modificar con la hoja con datos. Realmente los programadores no son brujos por modificar los codigos con hoja en blanco.

Espero su respuesta :)

Un saludo desde Ambato, Ecuador
SCM
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:PROCESO LENTO

Publicado por catita zarate (11 intervenciones) el 27/03/2009 07:28:32
para ser mas clara, estos son mis registros de las 2 hojas por lo tanto, necesito seleccionar distintos registros de lahoja("3.6.6") los codigos de la hoja("STOCK & DEMANDA") y ubicarlos en diferentes celdas de la hoja ("STOCK & DEMANDA")
el problema es a medida que utilizo mas ELSEIF dentro del BUCLE el proceso demora(3 minutos) aun mas ¿sera posible optimizar mas el codigo para que el proceso sea mas rapido?

hoja("3.6.6")

ALMACEN UBICACIÓN CODIGO DESCRIPCION CANTIDAD

400 101->400 415123 YOG ACTIV CIRUELA 120 GRC 840.00
300 200->300 415222 ACTIVIA LIGHT FRUTI 120GC 720
200 101->200 430674 FLAN DIET VAINILL 24x120C 0.00
100 cccc01 100103 LECHE UHT NATURAL 12x1CAJ 734.00
200 REF 100160 SOFT SERV MCD VAIN 12x1CA 3,058.00
100 cccc01 100554 LECHE UHT SEMIDESCR 12x1C 449.00
500 aba 120116 LECHE UHT CHOCOL 30x200CA 3,033.00
100 cccc01 120116 LECHE UHT CHOCOL 30x200CA 17.00
300 ABA 120116 LECHE UHT CHOCOL 30x200CA 3,017.00
100 cccc01 120116 LECHE UHT CHOCOL 30x200CA 3,081.00
200 ref 120116 LECHE UHT CHOCOL 30x200CA 35.00
400 REF01 120116 LECHE UHT CHOCOL 30x200CA 3,079.00
100 cccc01 120116 LECHE UHT CHOCOL 30x200CA 2,792.00
100 cccc01 120116 LECHE UHT CHOCOL 30x200CA 2,926.00
100 cccc01 120121 LECHE UHT FRUTILL 30x200C 4,454.00
500 101->500 120121 LECHE UHT FRUTILL 30x200C 374.00
101 aa0101 120121 LECHE UHT FRUTILL 30x200C 4,596.00
200 puth01 120121 LECHE UHT FRUTILL 30x200C 3,783.00
100 cccc01 120261 LE UHT CHOC LIGHT 30x200C 3,059.00
300 REF 120623 LECH UHT CHOC LIGHT 12x1C 1,561.00
100 cccc01 120624 LECHE UHT CHOCOLATE 12x1C 2,368.00
300 ABA 120624 LECHE UHT CHOCOLATE 12x1C 2,373.00
101 b4001 120628 LECH UHT FRUT LIGHT 12x1C 1,464.00
100 cccc01 140373 CREMA UHT LIGHT 30x200CAJ 11.00
400 REF03 140564 CREMA UHT 35% MG 12x1CAJA 749

hoja("STOCK & DEMANDA")

Cod_Art. Descripcion

100103 LECHE UHT NATURAL 12x1CAJ
100155 SOFT SERV MCD CHOC 12x1CA
100160 SOFT SERV MCD VAIN
100161 SOFT S. MCD VAIN 5% 12x1C
100200 MEZ HELADO VAINILLA 12x1C
100201 MEZ HELADO CHOCOL 12x1CAJ
120116 LECHE UHT CHOCOL 30x200CA
120121 LECHE UHT FRUTILL 30x200C
120130 LECHE UHT MOKKA L 30x200
120131 LECHE UHT CAPPUCC 30x200
120132 LECHE UHT CARAMEL L 30x200
120261 LE UHT CHOC LIGHT 30x200C
120262 LE UHT FRUT LIGHT 30x200C
120623 LECH UHT CHOC LIGHT 12x1C
120624 LECHE UHT CHOCOLATE 12x1C
120627 LECHE UHT FRUTILLA 12x1CA
120628 LECH UHT FRUT LIGHT 12x1C
120630 LECHE UHT MOKKA LAT 12x1C
120631 LECHE UHT CAPUCCINO 12x1C
120632 LECHE UHT CARAMEL 12x1CAJ
140371 CREMA UHT PARM 30x200
140373 CREMA UHT LIGHT 30x200
140564 CREMA UHT 35% MG 12x1CAJA
180565 LECHE COND AZUC 48x396grC
210201 NECTAR UHT NARANJ 30x200C
210206 NECTAR UHT PINA 30x200CAJ
210211 NECTAR UHT MANZAN 30x200C
210215 NECTAR UHT DAMASCO 12x1
210216 NECTAR UHT DAMASC 30x200
210220 NECTAR UHT DURAZNO 12x1
210221 NECTAR UHT DURAZN 30x200

el codigo que estoy trabajando es el siguiente:

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim filaQ%, filaP%, SUM&, filaX%, old&, sVal$, SUMA&, SUMAR&, SUMARSE&, SUMARSE1&, SUMARSE2&
Dim SUMARSE3&, SUMAR1&, SUMAR2&, SUMAR3&

With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set ws1 = Worksheets("STOCK & DEMANDA")
Set ws2 = Worksheets("3.6.6")

'ws1.Range("D6:AF180").Value = Empty
filaX = 6
With ws2
While ws1.Cells(filaX, 1).Value <> ""
SUM = 0
SUMA = 0
SUMAR = 0
SUMAR1 = 0
SUMAR2 = 0
SUMAR3 = 0
SUMARSE = 0
SUMARSE1 = 0
SUMARSE2 = 0
SUMARSE3 = 0
filaQ = 7
While ws2.Cells(filaQ, 16).Value <> ""
sVal = .Cells(filaQ, 15).Value
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

If .Cells(filaQ, 14).Value = "101" And (sVal = "ptre02" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUM = SUM + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 5).Value = SUM
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

ElseIf .Cells(filaQ, 14).Value = "100" And sVal = "cccc01" _
And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMA = SUMA + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 7).Value = SUMA
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

ElseIf .Cells(filaQ, 14).Value = "200" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR = SUMAR + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 8).Value = SUMAR
'ÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇ

ElseIf .Cells(filaQ, 14).Value = "300" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR1 = SUMAR1 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 13).Value = SUMAR1
'(((((((((((((((((((((((((((((((((((((

ElseIf .Cells(filaQ, 14).Value = "400" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR2 = SUMAR2 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 18).Value = SUMAR2
'))))))))))))))))))))))))))))))))))))))

ElseIf .Cells(filaQ, 14).Value = "500" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR3 = SUMAR3 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 23).Value = SUMAR3
'¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿

ElseIf .Cells(filaQ, 14).Value = "200" And _
sVal = "101->200" And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE = SUMARSE + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 12).Value = SUMARSE
'""""""""""""""""""""""""""""""""""""""

ElseIf .Cells(filaQ, 14).Value = "300" And _
(sVal = "101->300" Or sVal = "200->300") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE1 = SUMARSE1 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 17).Value = SUMARSE1
'¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡

ElseIf .Cells(filaQ, 14).Value = "400" And _
(sVal = "101->400" Or sVal = "200->400") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE2 = SUMARSE2 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 22).Value = SUMARSE2
'¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿

ElseIf .Cells(filaQ, 14).Value = "500" And _
(sVal = "101->500" Or sVal = "200->500") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE3 = SUMARSE3 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 27).Value = SUMARSE3
End If
filaQ = filaQ + 1
Wend
filaX = filaX + 1
Wend
End With

With Application
.ScreenUpdating = True
.Calculation = old
.EnableEvents = True
End With

Set ws1 = Nothing
Set ws2 = Nothing

End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:PROCESO LENTO

Publicado por catita zarate (11 intervenciones) el 27/03/2009 07:35:44
para ser mas clara, estos son mis registros de las 2 hojas por lo tanto, necesito seleccionar distintos registros de lahoja("3.6.6") los codigos de la hoja("STOCK & DEMANDA") y ubicarlos en diferentes celdas de la hoja ("STOCK & DEMANDA")
el problema es a medida que utilizo mas ELSEIF dentro del BUCLE el proceso demora(3 minutos) aun mas ¿sera posible optimizar mas el codigo para que el proceso sea mas rapido?
ojo son mas de 4000 registros en hoja(("3.6.6") y 180 en hoja("STOCK & DEMANDA") !

hoja("3.6.6")

ALMACEN UBICACIÓN CODIGO DESCRIPCION CANTIDAD

400--------- 101->400-- 415123--- YOG ACTIV CIRUELA 120 GRC 840.00
300---------- 200->300-- 415222----- ACTIVIA LIGHT FRUTI 120GC 720
200--------- 101->200-- 430674----- FLAN DIET VAINILL 24x120C 0.00
100--------- cccc01------ 100103----- LECHE UHT NATURAL 12x1CAJ 734.00
200--------- REF--------- 100160----- SOFT SERV MCD VAIN 12x1CA 3,058.00
100--------- cccc01------ 100554----- LECHE UHT SEMIDESCR 12x1C 449.00
500--------- aba--------- 120116----- LECHE UHT CHOCOL 30x200CA 3,033.00
100--------- cccc01------ 120116----- LECHE UHT CHOCOL 30x200CA 17.00
300---------- ABA--------- 120116----- LECHE UHT CHOCOL 30x200CA 3,017.00
100---------- cccc01------ 120116----- LECHE UHT CHOCOL 30x200CA 3,081.00
200---------- ref------------ 120116----- LECHE UHT CHOCOL 30x200CA 35.00
400---------- REF01------ 120116---- LECHE UHT CHOCOL 30x200CA 3,079.00
100---------- cccc01------ 120116----- LECHE UHT CHOCOL 30x200CA 2,792.00
100--------- cccc01------ 120116---- LECHE UHT CHOCOL 30x200CA 2,926.00
100---------- cccc01------ 120121---- LECHE UHT FRUTILL 30x200C 4,454.00
500---------- 101->500-- 120121---- LECHE UHT FRUTILL 30x200C 374.00
101---------- aa0101----- 120121---- LECHE UHT FRUTILL 30x200C 4,596.00
200---------- puth01----- 120121---- LECHE UHT FRUTILL 30x200C 3,783.00
100---------- cccc01------ 120261---- LE UHT CHOC LIGHT 30x200C 3,059.00
300---------- REF--------- 120623---- LECH UHT CHOC LIGHT 12x1C 1,561.00
100---------- cccc01------ 120624---- LECHE UHT CHOCOLATE 12x1C 2,368.00
300---------- ABA---------- 120624---- LECHE UHT CHOCOLATE 12x1C 2,373.00
101---------- b4001------- 120628---- LECH UHT FRUT LIGHT 12x1C 1,464.00
100---------- cccc01------ 140373---- CREMA UHT LIGHT 30x200CAJ 11.00
400---------- REF03------ 140564----- CREMA UHT 35% MG 12x1CAJA 749

hoja("STOCK & DEMANDA")

Cod_Art. Descripcion

100103 LECHE UHT NATURAL 12x1CAJ
100155 SOFT SERV MCD CHOC 12x1CA
100160 SOFT SERV MCD VAIN
100161 SOFT S. MCD VAIN 5% 12x1C
100200 MEZ HELADO VAINILLA 12x1C
100201 MEZ HELADO CHOCOL 12x1CAJ
120116 LECHE UHT CHOCOL 30x200CA
120121 LECHE UHT FRUTILL 30x200C
120130 LECHE UHT MOKKA L 30x200
120131 LECHE UHT CAPPUCC 30x200
120132 LECHE UHT CARAMEL L 30x200
120261 LE UHT CHOC LIGHT 30x200C
120262 LE UHT FRUT LIGHT 30x200C
120623 LECH UHT CHOC LIGHT 12x1C
120624 LECHE UHT CHOCOLATE 12x1C
120627 LECHE UHT FRUTILLA 12x1CA
120628 LECH UHT FRUT LIGHT 12x1C
120630 LECHE UHT MOKKA LAT 12x1C
120631 LECHE UHT CAPUCCINO 12x1C
120632 LECHE UHT CARAMEL 12x1CAJ
140371 CREMA UHT PARM 30x200
140373 CREMA UHT LIGHT 30x200
140564 CREMA UHT 35% MG 12x1CAJA
180565 LECHE COND AZUC 48x396grC
210201 NECTAR UHT NARANJ 30x200C
210206 NECTAR UHT PINA 30x200CAJ
210211 NECTAR UHT MANZAN 30x200C
210215 NECTAR UHT DAMASCO 12x1
210216 NECTAR UHT DAMASC 30x200
210220 NECTAR UHT DURAZNO 12x1
210221 NECTAR UHT DURAZN 30x200

el codigo que estoy trabajando es el siguiente:

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim filaQ%, filaP%, SUM&, filaX%, old&, sVal$, SUMA&, SUMAR&, SUMARSE&, SUMARSE1&, SUMARSE2&
Dim SUMARSE3&, SUMAR1&, SUMAR2&, SUMAR3&

With Application
.ScreenUpdating = False
old = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set ws1 = Worksheets("STOCK & DEMANDA")
Set ws2 = Worksheets("3.6.6")

'ws1.Range("D6:AF180").Value = Empty
filaX = 6
With ws2
While ws1.Cells(filaX, 1).Value <> ""
SUM = 0
SUMA = 0
SUMAR = 0
SUMAR1 = 0
SUMAR2 = 0
SUMAR3 = 0
SUMARSE = 0
SUMARSE1 = 0
SUMARSE2 = 0
SUMARSE3 = 0
filaQ = 7
While ws2.Cells(filaQ, 16).Value <> ""
sVal = .Cells(filaQ, 15).Value
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

If .Cells(filaQ, 14).Value = "101" And (sVal = "ptre02" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUM = SUM + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 5).Value = SUM
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

ElseIf .Cells(filaQ, 14).Value = "100" And sVal = "cccc01" _
And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMA = SUMA + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 7).Value = SUMA
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

ElseIf .Cells(filaQ, 14).Value = "200" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR = SUMAR + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 8).Value = SUMAR
'ÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇÇ

ElseIf .Cells(filaQ, 14).Value = "300" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR1 = SUMAR1 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 13).Value = SUMAR1
'(((((((((((((((((((((((((((((((((((((

ElseIf .Cells(filaQ, 14).Value = "400" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR2 = SUMAR2 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 18).Value = SUMAR2
'))))))))))))))))))))))))))))))))))))))

ElseIf .Cells(filaQ, 14).Value = "500" And (sVal = "ABA" Or _
sVal = "ptre02" Or sVal = "REF" Or _
sVal = "ref53" Or sVal = "ptuh01" Or _
sVal = "aba" Or sVal = "ref01" Or _
sVal = "ref" Or sVal = "ref02" Or _
sVal = "aa0101" Or sVal = "ref1387" Or _
sVal = "ba0101" Or sVal = "a0101" Or _
sVal = "c0101" Or sVal = "a9901" Or _
sVal = "b4001") And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMAR3 = SUMAR3 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 23).Value = SUMAR3
'¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿

ElseIf .Cells(filaQ, 14).Value = "200" And _
sVal = "101->200" And .Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE = SUMARSE + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 12).Value = SUMARSE
'""""""""""""""""""""""""""""""""""""""

ElseIf .Cells(filaQ, 14).Value = "300" And _
(sVal = "101->300" Or sVal = "200->300") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE1 = SUMARSE1 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 17).Value = SUMARSE1
'¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡

ElseIf .Cells(filaQ, 14).Value = "400" And _
(sVal = "101->400" Or sVal = "200->400") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE2 = SUMARSE2 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 22).Value = SUMARSE2
'¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿

ElseIf .Cells(filaQ, 14).Value = "500" And _
(sVal = "101->500" Or sVal = "200->500") And _
.Cells(filaQ, 16).Value = ws1.Cells(filaX, 1).Value Then
SUMARSE3 = SUMARSE3 + .Cells(filaQ, 18).Value
ws1.Cells(filaX, 27).Value = SUMARSE3
End If
filaQ = filaQ + 1
Wend
filaX = filaX + 1
Wend
End With

With Application
.ScreenUpdating = True
.Calculation = old
.EnableEvents = True
End With

Set ws1 = Nothing
Set ws2 = Nothing

End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de JuanC

RE:PROCESO LENTO

Publicado por JuanC (1052 intervenciones) el 27/03/2009 13:04:10
creo que ya te lo dije, lo vuelvo a repetir:
deberías usar un bucle For Each ... In en lugar del While ... Wend
Dim c As Range
For Each c In [A1:J100]
If c.Value = "..." Then
...
End If
Next

otro método que también es muy rápido es por medio de... un ejemplo...

Dim Mx As Variant
Dim i&, j&, m&, n&
Dim rng As Range
Set rng = [A1:J100]
With rng
m = .Rows.Count
n = .Columns.Count
Mx = .Value
End With
For i = 1 To m
For j = 1 To n
If Mx(i, j) = "..." Then
...
End If
Next
Next

en cualquiera de los casos tendrás que modificar todo el código,
pero te aseguro que el tiempo invertido en ello tendrá su recompensa...

Saludos desde Baires, JuanC
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar