26. december 2007 - 12:21Der er
5 kommentarer og 1 løsning
opslag i tabel med flere kriterier
Jeg skal lave en formel med opslag i en tabel med kol A til S. Kol A er sorteret stigende med grupper af ens værdier. I kol B til I er der også en del ens værdier, men placeret forskellige steder afhængig af de værdierne i de øvrige kolonner. I kol A til I skal alle vælges største værdi under referenceværdien (der er en referenceværdi til hver kolonne). I kol J og K vælges mellem 1 og 0 (1 er rigtig). Når der er fundet den rigtige række, hvor værdierne i kol A til K passer, skal vælges største tal under 100 i kol L til S. Resultatet jeg skal bruge er både værdien fra kol L til S og værdien fra række 9 i den kolonne (L-S).
Jeg kan lave en hjælpekolonne til hver af de øvrige kolonner med værdien 1/0 og trække de to resultater ud på denne måde, men det giver en masse formler og et stort ark. Ville gerne reducere dette, hvis man kan.
I lang tid har samarbejdsbranchen fokuseret på at forbedre enhedsfunktioner – bedre kameraer, klarere lyd og smartere software. Men den virkelige forvandling handler ikke om funktioner.
kolA kolB kolC kolD kolE kolF kolG kolH kolI kolJ kolK
If stRæk = slRæk Or slRæk > stRæk Then findStørsteVærdi Else MsgBox ("Entydighed ikke opnået") End If End Sub Private Sub sletMarkeringer() Rem Farver Range(Cells(forudsætStartRæk - 1, 1), Cells(maxRæk, kolOpslag + kolMax)).Select Selection.Interior.ColorIndex = xlNone Cells(aktuelRæk, 1).Select
Rem tidl. resultater Range(åseDim) = "" Range(beLast) = "" End Sub Private Function findAntalRækker() For r = forudsætStartRæk To 65000 cv = Cells(r, 1) If Cells(r, 1) = "" Or IsEmpty(Cells(r, 1)) = True Then findAntalRækker = r - 1 Exit Function End If Next r End Function Private Sub kolA() findInterval 1, 0 '0: < End Sub Private Sub kolB() findInterval 2, 0 '-"- End Sub Private Sub kolC() findInterval 3, 1 '1: = End Sub Private Sub kolD() findInterval 4, 2 '2: <= End Sub Private Sub kolE() findInterval 5, 2 '-"- End Sub Private Sub kolF() findInterval 6, 2 '-"- End Sub Private Sub kolG() findInterval 7, 1 '1: = End Sub Private Sub kolH() findInterval 8, 1 '-"- End Sub Private Sub kolI() findInterval 9, 1 '-"- End Sub Private Sub kolJ() findInterval 10, 1 '-"- End Sub Private Sub kolK() findInterval 11, 1 '-"- End Sub Rem ============================== Private Sub findInterval(kol, comp) Dim akTuel, forudSætning akTuel = Cells(aktuelRæk, kol) stRæk = 0 slRæk = 0
For r = intervalStart To intervalSlut forudSætning = Cells(r, kol)
Rem MINDRE END If comp = 0 Then If forudSætning < akTuel Then If stRæk = 0 Then stRæk = r Else If forudSætning > Cells(stRæk, kol) Then stRæk = r Else If forudSætning = Cells(stRæk, kol) Then slRæk = r End If End If End If End If Else Rem MINDRE END/LIG MED If comp = 2 Then If forudSætning <= akTuel Then If stRæk = 0 Then stRæk = r Else slRæk = r End If End If Else Rem LIG MED If forudSætning = akTuel Then If stRæk = 0 Then stRæk = r Else slRæk = r End If End If End If End If Next r
If stRæk = 0 And slRæk = 0 Then 'ingen mindre end stRæk = forudsætStartRæk slRæk = maxRæk Else If stRæk > 0 And slRæk = 0 Then slRæk = stRæk End If End If
Range(Cells(stRæk, kol), Cells(slRæk, kol)).Select Selection.Interior.ColorIndex = gul
intervalStart = stRæk intervalSlut = slRæk End Sub Private Sub findStørsteVærdi() Dim maxVærdi, maxKol maxVærdi = 0 maxKol = 0
For kol = kolOpslag + 1 To kolOpslag + kolMax If Cells(stRæk, kol) > maxVærdi Then maxVærdi = Cells(stRæk, kol) maxKol = kol End If Next kol
If maxKol > 0 Then Cells(stRæk, maxKol).Interior.ColorIndex = gul Cells(forudsætStartRæk - 1, maxKol).Interior.ColorIndex = gul
Range(åseDim) = Cells(forudsætStartRæk - 1, maxKol) Range(beLast) = maxVærdi End If End Sub Private Sub CommandButton1_Click() beregning End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
