04. september 2006 - 10:23Der er
17 kommentarer og 2 løsninger
Automatisk midling af rådata
Hej
Jeg har en kollone med rådata i et excel regneark - som skal midles. Rådata skal deles i tre lige store dele - hver del skal midles - og så skal man vurderer om de tre midlede data er stabile nok. Hvis de ikke er, tager man nogle flere data - deler i tre lige store dele, midler ….. osv. Jeg vil vide hvor mange data jeg skal bruge for at have en midling der er god nok.
Sådan skal det gøres:
Jeg stiller markøren i toppen af kollonen - tager data fra felt 1-3 og midler dem - tager data fra felt 4-6 og midler dem - tager data fra felt 7-9 og midler dem. Sammenligningen af de tre sæt midlede data skal udregnes i procent efter denne måde: (Største middelværdi - mindste middelværdi)/middelværdien af alle tre middelværdier * 100 Hvis den procentvise forskel er mindre end 2% - så har jeg en midling der er god - hvis den er større end 2% - skal der nogle flere tal til. Så - tager vi data fra felt 1-4 og midler dem - tager vi data fra felt 5-8 og midler dem - tager vi data fra felt 9-12 og midler dem Der laves en sammenligning efter samme formel - hvis forskel er under 2% - fint - ellers….. - tager vi data fra felt 1-5 og midler dem - tager vi data fra felt 6-10 og midler dem
osv. osv.
Når jeg hra tal nok, så jeg kan lave en passende god midling, vil jeg gerne vide hvor mange data jeg har brugt - og hvad resultatet er blevet til... og hvis det nemt kan lade sig gøre, så se udviklingen af den procentvise forskel - fx. i form af en kurve.
Jeg tror jeg skal op i nærheden af 3 sæt hver bestående af 100 værdier = 300 rækker rådata - inden jeg har en midling der er god nok.
Er der nogen der kan hjælpe mig med noget programmering der kan klare det?
Private Sub CommandButton1_Click() Dim Antal, Forsoeg Antal = 3 Dim rankarray() As Integer ReDim Preserve rankarray(2)
For Forsoeg = 1 To 500 AVG = 0 For i = 1 To Antal AVG = AVG + Range("A" & i).Value Next rankarray(0) = AVG / Antal * 1000 Range("B" & Antal).Value = rankarray(0) / 1000
AVG = 0 For I2 = Antal + 1 To Antal * 2 AVG = AVG + Range("A" & I2).Value MIDDEL2 = AVG / Antal Next rankarray(1) = MIDDEL2 * 1000 Range("B" & Antal * 2).Value = rankarray(1) / 1000
AVG = 0 For I3 = Antal * 2 + 1 To Antal * 3 AVG = AVG + Range("A" & I3).Value MIDDEL3 = AVG / Antal Next rankarray(2) = MIDDEL3 * 1000 Range("B" & Antal * 3).Value = rankarray(2) / 1000
N = UBound(rankarray) swap = True Do While swap swap = False For i = 1 To N - 1 For j = i To N If rankarray(i) > rankarray(j) Then Temp = rankarray(i) rankarray(i) = rankarray(j) rankarray(j) = Temp swap = True End If Next Next Loop Gnsnit = 0 For Z = 0 To 2 Gnsnit = Gnsnit + rankarray(Z) Next Gnsnit = Gnsnit / 3
RESULT = (rankarray(2) - rankarray(0)) / Gnsnit * 100 Range("C" & Forsoeg).Value = RESULT
If RESULT <= 2 And RESULT >= -2 Then Range("D" & Forsoeg).Value = RESULT MsgBox "Kom frem til resultatet!" Exit Sub End If Columns("B:B").Select Selection.ClearContents Antal = Antal + 1 ReDim rankarray(2) Next End Sub
Private Sub CommandButton1_Click() Dim Data1 As Variant, Data2 As Variant, Data3 As Variant, RW As Long, Gentagelse As Integer, PRC As Double Dim MI1, MI2, Mi3 Dim Mindste, Største, Gennemsnit RW = Cells(65536, ActiveCell.Column).End(xlUp).Row For Gentagelse = 2 To RW / 3 'ret =2 til = 3, hvis du vil starte med de 3 første række Data1 = Range(Cells(1, ActiveCell.Column), Cells(Gentagelse, ActiveCell.Column)) Data2 = Range(Cells(Gentagelse + 1, ActiveCell.Column), Cells(Gentagelse + Gentagelse, ActiveCell.Column)) Data3 = Range(Cells(Gentagelse + Gentagelse + 1, ActiveCell.Column), Cells(Gentagelse + Gentagelse + Gentagelse, ActiveCell.Column)) MI1 = Application.WorksheetFunction.Average(Data1) MI2 = Application.WorksheetFunction.Average(Data2) Mi3 = Application.WorksheetFunction.Average(Data3) Mindste = Application.WorksheetFunction.Min(MI1, MI2, Mi3) Største = Application.WorksheetFunction.Max(MI1, MI2, Mi3) Gennemsnit = Application.WorksheetFunction.Average(MI1, MI2, Mi3) PRC = ((Største - Mindste) / Gennemsnit) * 100 '(Største middelværdi - mindste middelværdi)/middelværdien af alle tre middelværdier * 100 If PRC <= 2 Then MsgBox " Midlet ved gennemsnit af " & Gentagelse * 3 & " Forskel = " & PRC & "%" End If Next End Sub
Private Sub CommandButton1_Click() Dim Antal, Forsoeg Antal = 3 Dim rankarray() As Integer ReDim Preserve rankarray(3)
Columns("B:D").Select Selection.ClearContents
For Forsoeg = 1 To 500 AVG = 0 For I = 1 To Antal AVG = AVG + Range("A" & I).Value Next rankarray(1) = AVG / Antal * 1000 Range("B" & Antal).Value = rankarray(1) / 1000
AVG = 0 For I2 = Antal + 1 To Antal * 2 AVG = AVG + Range("A" & I2).Value MIDDEL2 = AVG / Antal Next rankarray(2) = MIDDEL2 * 1000 Range("B" & Antal * 2).Value = rankarray(2) / 1000
AVG = 0 For I3 = Antal * 2 + 1 To Antal * 3 AVG = AVG + Range("A" & I3).Value MIDDEL3 = AVG / Antal Next rankarray(3) = MIDDEL3 * 1000 Range("B" & Antal * 3).Value = rankarray(3) / 1000
N = UBound(rankarray) swap = True Do While swap swap = False For I = 1 To N - 1 For j = I To N If rankarray(I) > rankarray(j) Then Temp = rankarray(I) rankarray(I) = rankarray(j) rankarray(j) = Temp swap = True End If Next Next Loop Gnsnit = 0 For Z = 1 To 3 Gnsnit = Gnsnit + rankarray(Z) Next Gnsnit = Gnsnit / 3
RESULT = (rankarray(3) - rankarray(1)) / Gnsnit * 100 Range("C" & Forsoeg).Value = RESULT
If RESULT <= 2 And RESULT >= -2 Then Range("D" & Forsoeg).Value = RESULT MsgBox "Kom frem til resultatet!" Exit Sub End If Columns("B:B").Select Selection.ClearContents Antal = Antal + 1 ReDim rankarray(3) Next End Sub
Første: Når jeg har det ønskede resultat - er jeg ikke intereseret i flere målinger - så skal rutinen bare stoppe - eller jeg skal have mulighed for at cancle.
Anden: Kan der tilføjes et eller andet, så at resultater kommer til at stå i regnearket - fx en ny kollone til højre for den kollone med rådata? Det der gerne må stå er: MI1 MI2 MI3 Gennemsnit PRC Antal rækker.
Du kan skrive det som et svar, så skal du få dine point.
Akyhne > nu vil jeg jo ikke tage point fra dig, du har gjort et stort arbejde, med at finde ud af det. Det jeg prøver, er at vise at man kan bruge de indbyggede funktioner, til ar regne det ud. Envidere læser jeg ind i variabler, det gør koden hurtigere.
Så hvis nogen skal have point er det akyhne.
Her er en rettet kode
Private Sub CommandButton1_Click() Dim Data1 As Variant, Data2 As Variant, Data3 As Variant, RW As Long, Gentagelse As Integer, PRC As Double Dim MI1, MI2, MI3, Svar Dim Mindste, Største, Gennemsnit RW = Cells(65536, ActiveCell.Column).End(xlUp).Row Range(Cells(1, ActiveCell.Column), Cells(RW, ActiveCell.Column)).Interior.ColorIndex = xlNone For Gentagelse = 3 To RW / 3 'ret =2 til = 3, hvis du vil starte med de 3 første række Data1 = Range(Cells(1, ActiveCell.Column), Cells(Gentagelse, ActiveCell.Column)) Data2 = Range(Cells(Gentagelse + 1, ActiveCell.Column), Cells(Gentagelse + Gentagelse, ActiveCell.Column)) Data3 = Range(Cells(Gentagelse + Gentagelse + 1, ActiveCell.Column), Cells(Gentagelse + Gentagelse + Gentagelse, ActiveCell.Column)) MI1 = Application.WorksheetFunction.Average(Data1) MI2 = Application.WorksheetFunction.Average(Data2) MI3 = Application.WorksheetFunction.Average(Data3) Mindste = Application.WorksheetFunction.Min(MI1, MI2, MI3) Største = Application.WorksheetFunction.Max(MI1, MI2, MI3) Gennemsnit = Application.WorksheetFunction.Average(MI1, MI2, MI3) PRC = ((Største - Mindste) / Gennemsnit) * 100 '(Største middelværdi - mindste middelværdi)/middelværdien af alle tre middelværdier * 100 If PRC <= 2 Then Svar = MsgBox(" Midlet ved gennemsnit af " & Gentagelse * 3 & vbCrLf & _ " Forskel = " & PRC & "%" & vbCrLf & _ "1. middel = " & MI1 & vbCrLf & _ "2. middel = " & MI2 & vbCrLf & _ "3. middel = " & MI3 & vbCrLf & _ "Gennemsnit = " & Gennemsnit & vbCrLf & _ vbCrLf & _ " Vil du afslutte Ja / nej", vbYesNo) If Svar = vbYes Then Range(Cells(1, ActiveCell.Column), Cells(Gentagelse, ActiveCell.Column)).Interior.ColorIndex = 6 Range(Cells(Gentagelse + 1, ActiveCell.Column), Cells(Gentagelse + Gentagelse, ActiveCell.Column)).Interior.ColorIndex = 7 Range(Cells(Gentagelse + Gentagelse + 1, ActiveCell.Column), Cells(Gentagelse + Gentagelse + Gentagelse, ActiveCell.Column)).Interior.ColorIndex = 8 Cells(Gentagelse, ActiveCell.Column).Offset(0, 1) = "MI1 =" & MI1 Cells(Gentagelse, ActiveCell.Column).Offset(1, 1) = "MI2 =" & MI2 Cells(Gentagelse, ActiveCell.Column).Offset(2, 1) = "MI3 =" & MI3 Cells(Gentagelse, ActiveCell.Column).Offset(3, 1) = "PRC =" & PRC Cells(Gentagelse, ActiveCell.Column).Offset(4, 1) = "Rækker =" & Gentagelse * 3 Exit Sub End If End If Next End Sub
Det er i hvertfald kotume at give point til alle der kommer med en rigtig løsning. Jeg mener endda det engang har stået i reglerne at første rigtige løsning trækker pointene. Men korriger mig, hvis jeg husker forkert. Jeg har dog absolut ikke noget imod at dele med andre.
kabbak: Ja, jeg kender godt funktionerne max, min, og average, men kunne ikke lige finde metoden til at bruge dem i en formel. Min VBA hjælp i Excel var gået død. Da der ikke var nogen af de skrappe hunde der, efter et par timer havde lagt en løsning, valgte jeg at putte koden herind. Den fungerer jo og regner endda rigtigt *SSS* i andet forsøg (bug'en var i sorteringen i middeludregningen)
Tak for jeres hjælp med programmering. Endnu engang har jeg valgt at bruge Kabbaks kode - det er noget jeg kan gennemskue.
Jeg har en kort karriere i Visual Basic programmering - jeg har et to dages kursus i EXCEL VBA (fra lige før sommerferien) - så når jeg har brug for noget kode der skal udføre en bestemt rutine, bruger jeg www.eksperten.dk til at finde en løsning.
Jeg har set og prøvet koder fra jer begge - men med det Kabbaks kode jeg kan forstå - og selv gå ind og justerer i, hvis der er noget jeg gerne vil have på en anden måde.
Akyhnes kode ser også ud til at virke fint - jeg kan bare ikke forstå det output der kommer ud - og endnu sværre ved at gå ind og læse koden, så jeg kan finde ud af hvad for et output der kommer ud.
Så hvis jeg skal give point til den rigtige løsning som JEG kan bruge - så vil jeg give dem til Kabbak.
Hvis ikke folk får point for de korrekte løsninger de laver, spredes det hurtigt, og så gider de heller ikke at hjælpe dig. Jeg lavede løsningen efter det du spurgte, og en del af det du ønskede. Som kabbak lavede jeg det ikke helt færdig i første omgang, da jeg ville afvente og se om du kunne bruge det. Det sker ofte at der kommer flere løsninger efter hinanden. Der plejer man at deles ad, eller første får point. Det er dem der har svaret korrekt der aftaler det indbyrdes. Hvis forslag man bruger må man selv om, men tænk lige på at jeg har siddet og brugt fritid på at hjælpe dig!
Her er i hvertfald et svar, så bestemmer din samvittighed resten.
kabbak skal putte et svar først. Du kan ved de optionbuttons der hedder svar- og kommentar nu se en lille table (firkant) med "akyhne". Der kommer kabbak også til at stå når han har svaret. Du markerer begge (blå), og trykker på en knap tæt ved (kan ikke huske hvad den hedder).
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.
