11. juni 2008 - 11:52
Der er
4 kommentarer og
1 løsning
Kan man gange med forskellige værdier alt efter indtastede værdi?
Hej
Er i gang med at lave et lille regneark der skal holde styr på lidt print information.
Jeg har lavet en lille "tabel" med datoer i ene side og papir formater(A4, A3, A3+). Det er så meningen at man skal kunne skrive en værdi(antal kopier) i en celle. Antallet skal så ganges med en værdi(pris, men prisen er forskellig alt efter om det 1-2 eller 2-10 kopier. Kan man lave noget smart så regnearket "selv" finder den rigtige pris alt efter indtaskede antal?
Håber I forstår hvad jeg mener el. har nogle gode ideér til hvorledes det kan laves.
På forhånd tak
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
