Kan man gange med forskellige værdier alt efter indtastede værdi?

Du er velkommen til at sende en kopi af dit regneark til: pb@supertekst-it.dk
Skulle nok kunne lade sig gøre.

Hej

Det lyder bare fornemt:-) Sender dig lige en mail og vedhæfter en kopi af regnearket.

Mange tak

Ok - jeg afventer...

Fil med 2 ark SagsIndtastning og PrisMatriks
Rem Version 3 - 12-06-08
Rem ====================
Dim arkS                'KONSTANTER KAN MODIFICERES - HVIS DER ÆNDRES I ARK
Const sagsR1 = 7        'Sager  række  Start
Const sagsRx = 21      '-      -      Slut
Const sagsK1 = 4        '-      kolonne Start
Const sagsK9 = 11      '-      -      Slut

Dim arkP
Const prisR1 = 5        'Priser række  Start
Const prisR9 = 8        '-      -      Slut
Private Sub opsætArk()
    Set arkS = ActiveWorkbook.Sheets("Sager")
    Set arkP = ActiveWorkbook.Sheets("Priser")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    opsætArk
   
    kol = Target.Column
    ræk = Target.Row
   
    If erDetAntalCelle(kol, ræk) = True Then
        antal = Target.Value
        beregn ræk
    End If
    Application.ScreenUpdating = True
End Sub
Private Function erDetAntalCelle(kol, ræk)
    If ræk >= sagsR1 And ræk <= sagsRx And _
      kol >= sagsK1 And kol <= sagsK9 Then
        erDetAntalCelle = True
        Exit Function
    End If
    erDetAntalCelle = False
End Function
Private Sub beregn(ræk)
Dim totPris
    totPris = 0
   
    arkS.Activate
Rem beregn total
    For kol = sagsK1 To sagsK9
        antalCelle = ActiveSheet.Cells(ræk, kol)
        If antalCelle <> "" Then
          pris = findPris(antalCelle, kol)
          arkS.Activate
          totPris = totPris + antalCelle * pris
        End If
    Next kol
   
    If totPris > 0 Then
        ActiveSheet.Cells(ræk, sagsK9 + 1) = totPris
    Else
        ActiveSheet.Cells(ræk, sagsK9 + 1) = ""
    End If
End Sub
Private Function findPris(antal, kol)
Dim fra As Integer, til As Integer, p, interval
    arkP.Activate
    For ræk = prisR1 To prisR9
        interval = ActiveSheet.Cells(ræk, 1)
        p = InStr(interval, "-")
        If p = 0 Then
            MsgBox ("Fejl på prisArk")
            findPrisRække = 0
            Exit Function
        Else
            fra = Left(interval, p - 1)
            til = Mid(interval, p + 1)
            If antal >= fra And antal <= til Then
                findPris = ActiveSheet.Cells(ræk, kol - 1)
                Exit Function
            End If
        End If
    Next ræk
    MsgBox ("Fejl på prisArk")
    findPrisRække = 0
End Function

Regnearket virker lige efter hensigten:-) Tak for hjælp...