Alternatief voor matrix formule

[wiki]

DMV een matrixformule wordt een waarde in een rij en een kolomkop opgezocht in een ander blad. De matrixformule geeft het juiste resultaat, maar het aantal rijen in het werkblad is 2500 en het aantal kolommen is 5 maw 10.000 formules te berekenen, waardoor dit of heel lang duurt of excel loopt vast.
Ik heb geprobeerd per kolom te berekenen en daarna de waarden te kopieren, maar dan lukt het nog niet. De matrix formule is:

=ALS($A2="";"";(INDEX('70380 ArtPerprijslijn 31DEC09'!$D$1:$D25000;VERGELIJKEN(H$1&$A2;'70380 ArtPerprijslijn 31DEC09'!$A$1:$A10000&'70380 ArtPerprijslijn 31DEC09'!$B$1:$B10000;0))))

Heeft iemand een VBA loop oplossing of een kleine opzet?

gr wim

 

[wiki]

Sub Test1()

    With Range("h2:h" & Cells(Rows.Count, 1).End(xlUp).Row)

    .Cells.FormulaArray = "=IF(RC1="""","""",(INDEX('70380 ArtPerprijslijn 31DEC09'!R1C4:R[24998]C4,MATCH(R1C&RC1,'70380 ArtPerprijslijn 31DEC09'!R1C1:R[9998]C1&'70380 ArtPerprijslijn 31DEC09'!R1C2:R[9998]C2,0))))"

    .Value = .Value

        End With

    End Sub

1e poging, maar formule wordt niet berekend

gr wim

 

[wiki]

Onderstaande code werkt, maar is nog erg traag. Wie kan helpen?

Sub Prijs()
'
Application.Calculation = xlManual
Application.ScreenUpdating = False


Set currentcell = Range("h2")
Do While Not IsEmpty(currentcell.Offset(0, -1))
Set nextCell = currentcell.Offset(1, 0)

currentcell.FormulaArray = "=IF(RC1="""","""",(INDEX('70380 ArtPerprijslijn 31DEC09'!R1C4:R[24998]C4,MATCH(R1C&RC1,'70380 ArtPerprijslijn 31DEC09'!R1C1:R[9998]C1&'70380 ArtPerprijslijn 31DEC09'!R1C2:R[9998]C2,0))))"
 currentcell.Value = currentcell.Value
Set currentcell = nextCell
Loop
Range("a1").Select

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

End Sub

gr wim

 

[wiki]

Ik heb nu een deel van de oplossing, maar strand bij het volgende:

Sub Prijzen()

Range("b2").Select

    Do
 Set PN = Range("e:e").Find(ActiveCell.Value, LookIn:=xlValues, lookat:=xlWhole)
If PN Is Nothing Then

         Intersect(Rows(ActiveCell.Row), Union(Columns(2), Columns(3))).Copy [e65536].End(xlUp).Offset(1, 0)
         End If
         
         
        If ActiveCell.Offset(0, -1).Value = "Prijs 1" And ActiveCell.Offset(0, 2).Value > 0 Then
        ActiveCell.Offset(0, 2).Copy [e65536].End(xlUp).Offset(0, 2)
        End If
     
        If ActiveCell.Offset(0, -1).Value = "Prijs 2" And ActiveCell.Offset(0, 2).Value > 0 And ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        ActiveCell.Offset(0, 2).Copy [e65536].End(xlUp).Offset(0, 3)
        End If
            
        If ActiveCell.Offset(0, -1).Value = "Prijs 3" And ActiveCell.Offset(0, 2).Value > 0 And ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        ActiveCell.Offset(0, 2).Copy [e65536].End(xlUp).Offset(0, 4)
        End If
        
        If ActiveCell.Offset(0, -1).Value = "Prijs 4" And ActiveCell.Offset(0, 2).Value > 0 And ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        ActiveCell.Offset(0, 2).Copy [e65536].End(xlUp).Offset(0, 5)
        End If
        
        If ActiveCell.Offset(0, -1).Value = "Prijs 5" And ActiveCell.Offset(0, 2).Value > 0 And ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        ActiveCell.Offset(0, 2).Copy [e65536].End(xlUp).Offset(0, 6)
        End If
        
      
        ActiveCell.Offset(1, 0).Select
        
        
    Loop Until IsEmpty(ActiveCell.Offset(1, 0))

End Sub

   Intersect(Rows(ActiveCell.Row), Union(Columns(2), Columns(3))).Copy [e65536].End(xlUp).Offset(1, 0)
         End If

Is een hulpregel en komt te vervallen.

De bedoeling is nu dat de code begint in het overzicht met prijslijnen en deze copieert naar de rij met het juiste art.nr in het doelblad.

Wat niet lukt is om het doelblad en rij juist in de code te krijgen

ActiveCell.Offset(0, 2).Copy [e65536].End(xlUp).Offset(0, 3)

wie kan helpen?

gr wim

 

[tilpi]

Wim

=ALS(A2="";"";SOMPRODUCT((Blad2!$A$1:$D$100=B2)*(Blad2!$B$1:$B$100=A2)*(Blad2!$A$1:$A$100=$H$1)*(Blad2!$D$1:$D$100)))

Gaat het niet een stuk sneller met een niet-matrix-formule?

Mvg

Piet

 

[Wigi]

Piet

SOMPRODUCT is een (verkapte) matrixformule...

 

[wiki]

Mooie aanpassing, maar nog niet snel. Herberekenen duurt 8 minuten, maar excel loopt niet vast.

Ik vestig mijn hoop op VBA loop.

Maar toch bedankt piet.

gr wim

 

[Cobbe]

Ik heb een oplossing voor u maar enkel door een kleine lay-out aanpassing.

Cobbe

 

[wiki]

Opgelost. Code werkt nu en moet ik nog ombouwen naar werkelijk bestand.
In werkelijk bestand 45 Sec

Sub Prijzen()

Range("b2").Select

    Do
 Set pn = Range("b:b").Find(ActiveCell.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not pn Is Nothing Then

        ' Intersect(Rows(ActiveCell.Row), Union(Columns(2), Columns(3))).Copy [e65536].End(xlUp).Offset(1, 0)
         End If
         
        
        If ActiveCell.Offset(0, -1).Value = "Prijs 1" And ActiveCell.Offset(0, 2).Value > 0 Then
      Range("e" & pn.Row).Offset(0, 0).Value = ActiveCell.Offset(0, 2).Value
        End If
     
        If ActiveCell.Offset(0, -1).Value = "Prijs 2" And ActiveCell.Offset(0, 2).Value > 0 Then
        Range("e" & pn.Row).Offset(0, 1).Value = ActiveCell.Offset(0, 2).Value
        End If
            
        If ActiveCell.Offset(0, -1).Value = "Prijs 3" And ActiveCell.Offset(0, 2).Value > 0 Then
        Range("e" & pn.Row).Offset(0, 2).Value = ActiveCell.Offset(0, 2).Value
        End If
        
        If ActiveCell.Offset(0, -1).Value = "Prijs 4" And ActiveCell.Offset(0, 2).Value > 0 Then
        Range("e" & pn.Row).Offset(0, 3).Value = ActiveCell.Offset(0, 2).Value
        End If
        
        If ActiveCell.Offset(0, -1).Value = "Prijs 5" And ActiveCell.Offset(0, 2).Value > 0 Then
        Range("e" & pn.Row).Offset(0, 4).Value = ActiveCell.Offset(0, 2).Value
        End If
        
      
        ActiveCell.Offset(1, 0).Select
        
        
    Loop Until IsEmpty(ActiveCell.Offset(-1, 0))

End Sub

gr wim