Find stykpris i en prismatrix

Et bidrag - koden her er i en userform - kaldes fra ark1, matrix forefindes - do dit indlæg:

Dim antalProdukter, antalPriser
Dim Index(), Produkttab(), ix
Private Sub ListBox1_Click()                        'produkt valgt
    ix = Me.ListBox1.ListIndex
    Me.TextBox1.SetFocus
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox2.SetFocus
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    beregn
End Sub
Private Sub beregn()
Dim vægt As Integer, antal As Integer
    If Me.TextBox1 <> "" And Me.TextBox2 <> "" Then
        vægt = Me.TextBox1
        antal = Me.TextBox2
       
        If vægt <> 0 And antal <> 0 Then
Rem Beregning
            Me.l_stykPris.Caption = Format(findStykpris(antal), "###.#0")
        End If
    End If
End Sub
Private Function findStykpris(antal)
    For i = 0 To antalPriser - 1
        If antal >= Index(i, 0) And antal <= Index(i, 1) Then
            findStykpris = Produkttab(ix, i)
            Exit Function
        End If
    Next i
End Function
Private Sub UserForm_activate()
    opbygTabeller
    Me.ListBox1.ColumnWidths = "50;50"
   
    visProdukter
End Sub
Private Sub visProdukter()
    For ræk = 2 To 65000
        If Cells(ræk, 1) = "" Then
            Exit Sub
        Else
            Me.ListBox1.AddItem Cells(ræk, 1)
            Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(ræk, 2)
        End If
    Next ræk
End Sub
Private Sub opbygTabeller()
Dim fra As Integer, til As Integer, pris As Single
    antalPriser = ActiveCell.SpecialCells(xlLastCell).Column - 2
   
    ReDim Index(antalPriser, 2)
    For k = 3 To antalPriser + 2
        i = Cells(1, k)
        fra = Val(Left(i, InStr(i, "-") - 1))
        til = Val(Mid(i, InStr(i, "-") + 1))
        Index(k - 3, 0) = fra
        Index(k - 3, 1) = til
    Next k
   
    antalProdukter = ActiveCell.SpecialCells(xlLastCell).Row - 1
    ReDim Produkttab(antalProdukter, antalPriser)
    For r = 2 To antalProdukter + 1
        For k = 3 To antalPriser + 2
            pris = Cells(r, k)
            Produkttab(r - 2, k - 3) = pris
        Next k
    Next r
   
End Sub
------------------

Hele filen kan tilsendes fra: pb@supertekst-it.dk

Løsning 2:
Dim rækkeNr, kolonneNr
Private Sub worksheet_change(ByVal target As Excel.Range)
Dim række, kolonne
    kolonne = target.Column
    række = target.Row
   
    On Error GoTo noAction
Rem Test om ændring i kolonne D - E, og antal udfyldt & numerisk
    If target <> "" Then
        If kolonne >= 4 And kolonne <= 5 And Cells(række, 5) <> "" And IsNumeric(Cells(række, 5)) = True Then
            rækkeNr = findProduktVægt(Cells(række, 4))
            If rækkeNr > 0 Then
                kolonneNr = findAntal(Cells(række, 5))
                Cells(række, 6) = ActiveWorkbook.Sheets(1).Cells(rækkeNr, kolonneNr)
            End If
        End If
    End If
   
noAction:
End Sub
Private Function findProduktVægt(pId)
Dim produkt, vægt, produktVægt
    With ActiveWorkbook.Sheets(1)
        For ræk = 2 To 7
            produkt = .Cells(ræk, 2)
            vægt = .Cells(ræk, 3)
            produktVægt = produkt + " " + vægt
            If produktVægt = pId Then
                findProduktVægt = ræk
                Exit Function
            End If
        Next ræk
    End With
End Function
Private Function findAntal(antal)
Dim fra, til
    With ActiveWorkbook.Sheets(1)
        For kol = 4 To 7
            interval = .Cells(1, kol)
                fra = Val(Left(interval, InStr(interval, "-") - 1))
                til = Val(Mid(interval, InStr(interval, "-") + 1))
                If antal >= fra And antal <= til Then
                    findAntal = kol
                    Exit Function
                End If
        Next kol
        findAntal = 8
    End With
End Function