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.
Kommunerne har digitaliseret indgangen for borgerne. Men bag skærmen håndteres mange arbejdsgange stadig manuelt mellem systemer, mails og organisatoriske siloer.
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.
