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