28. november 2003 - 17:07Der er
10 kommentarer og 1 løsning
Fra værdier til binær matrice
I mit regneark har jeg 3 rækker med hver en værdi fra 1 til 27, i hver kolonne. Indholdet af disse 3 variabler for hvert individ er angivet i hver kolonne. F.eks: F01 2 3 2 F02 4 7 7 F03 18 9 9
Jeg ønsker nu at konvertere dette til en binær matrice, hvor rækkerne angiver hver værdi i udfaldsrummet (dvs. 1..27), og der skal så sættes tre 1-taller i hver række, udfor hver værdi iht. ovenstående. I eksemplet herover skal der foreksempel sættes 1-taller i celle A2, A4 og A18, i B3, B7 og B9, samt i C2, C7 og C9:
Bonusspørgsmål (hm, kan man egentlig give ekstra point her?): Det vil være endnu bedre hvis udfaldsrummet kunne være vilkårligt og at A-kolonnen indeholder elementerne i udfaldsrummet, og at den så stadig selv kunne finde ud af at placere 1-tallerne de rigtige steder i forhold til værdierne i A-kolonnen. Men det er nok en tand for kompliceret?
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Bemærk at rækkerne i eksemplet ovenfor har rykket sig en tak i eksemplet, så det er ikke vist helt korrekt, men jeg håber at det alligevel viser hvor jeg vil hen...
Yes, den gør det sgu! Men i praksis har jeg jo altså flere kolonner (ellers ville det være let nok at gøre det i hånden), og så skal jeg have 2 nye linjer i scriptet for hver eneste kolonne? Og så er jeg jo næsten lige vidt - at jeg lige så godt kunne gøre det manuelt? Kan det ikke automatiseres yderligere?
Sub BinaryMatrix() Dim start As Long, slut As Long, y As Long, x As Long Dim rng As Range, Output As Range, c As Range Dim temp() '************* U S E R I N P U T ********************* start = Application.InputBox("Lower limit") slut = Application.InputBox("Upper limit") Set rng = Application.InputBox("Input Area (only numbers)", , , , , , , 8) Set Output = Application.InputBox("First Output Cell", , , , , , , 8) '*******************************************************
ReDim temp(start To slut, rng.Rows.Count + 1) '**** Fyld array med udfaldsrummets tal **************** For y = start To slut temp(y, 0) = y Next '**** Lav den binære matrice *************************** For Each c In rng For x = start To slut If c.Value = x Then temp(x, c.Column - rng.Column + 1) = 1 Exit For End If Next Next '**** Fyld celler med matricen ************************* Output.Resize(slut - start + 1, rng.Rows.Count + 1) = temp End Sub
Sorry, jeg lavede samme fejl lidt længere oppe. du får lige hele koden igen.
Sub BinaryMatrix() Dim Start As Long, Slut As Long, y As Long, x As Long Dim rng As Range, Output As Range, c As Range Dim temp()
'************* U S E R I N P U T ********************* Start = Application.InputBox("Lower limit") Slut = Application.InputBox("Upper limit") Set rng = Application.InputBox("Input Area", , , , , , , 8) Set Output = Application.InputBox("First Output Cell", , , , , , , 8) '*******************************************************
ReDim temp(Start To Slut, rng.Columns.Count + 1)
'**** Fyld array med udfaldsrummets tal **************** For y = Start To Slut temp(y, 0) = y Next
'**** Lav den binære matrice *************************** For Each c In rng For x = Start To Slut If c.Value = x Then temp(x, c.Column - rng.Column + 1) = 1 Exit For End If Next Next
Hej Bak Undskyld, jeg har været syg, og så har der været konference. Nu er jeg tilbage på min pind og vil kigge på det. Det er mere kompliceret end jeg havde forestillet mig, jeg troede faktisk ikke at man skulle i gang med makroprogrammering. Nå, jeg kigger på det og vender tilbage. Mvh peter.
Hej Bak Jeg beklager at jeg har været så længe om det. Det ser ud til at virke. Så jeg har accepteret svaret. Tak for hjælpen, og godt nytår! Mvh Peter.
Synes godt om
Ny brugerNybegynder
Din løsning...
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.
