Excel makro, der beregner gennemsnit, forkert vægtning
Denne makro benyttes til at beregne et sum-gennemsnit ud fra 10 gennemsnit, desværre har jeg fundet ud af at rent matematisk er dette en forkert måde at beregne et sum-gennemsnit, da vægtningen af det enkelte gennemsnit bliver forkert. (100/4 + 50/2 etc . . . - giver ikke nødvendigvis 25)Da jeg ikke selv har lavet denne makro, kan jeg desværre ikke rigtig gennemstue den. Men jeg skal have den til at dividere en sum fra Ark1 med en sum fra Ark2, istedet for den metode den benytter nu(den tager tallene fra et Ark der dividere alle celler fra Ark1 med de samme celler fra Ark2).
Sub CalculateResults()
Dim SeasonsChange As Date, ActiveCellDate As Date, FirstDayOfYear As Date
SeasonsChange = "30-06"
If Now > SeasonsChange Then
SecondHalfYear = True
Else
SecondHalfYear = False
End If
FirstDayOfYear = "01-01"
Y_Row_Start = 2
X_Col_Start = 2
'Finder område for beregning
Sheets("Serier_Herrer").Select
Range("A1").Select
Cells.Find(What:="Stop", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Select
X_Row_Stop = ActiveCell.Row
Y_Row_Stop = 2
Range("A1").Select
Cells.Find(What:="Stop", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Select
X_Col_Stop = ActiveCell.Column - 1
Y_Row_End = X_Col_Stop + 1
Sheets("Resultat_Herrer").Select
'Ydre løkke - markerer området for den enkelte persons spilledage
For i = X_Col_Start To X_Col_Stop
X_Row_Start = i
Y_Row_Stop = i
Range(Cells(Y_Row_Start, X_Row_Start), Cells(X_Row_Stop, Y_Row_Stop)).Select
'Indre løkke - udregner hver persons tal
For j = X_Col_Stop To X_Col_Start Step -1
X_Row_Start = i
Y_Row_Start = j
Range(Cells(Y_Row_Start, X_Row_Start), Cells(Y_Row_Start, X_Row_Start)).Select
'Beregning af de 3 gennemsnit
Placeholder = ActiveCell.Value
If ActiveCell.Value <> 0 Then
Games = Games + 1
If Flag = 0 Then NextAverage = ActiveCell.Value
Range(Cells(Y_Row_Start, 1), Cells(Y_Row_Start, 1)).Select
ActiveCellDate = ActiveCell.Value
CellYY = Val(Right(ActiveCell.Value, 2))
CellMM = Val(Mid(ActiveCell.Value, 4, 2))
CurrentDate = Format(Now, "dd-mm-yy")
CurrentYY = Val(Right(CurrentDate, 2))
CurrentMM = Val(Mid(CurrentDate, 4, 2))
DiffYY = CurrentYY - CellYY
DiffMM = CurrentMM - CellMM
Range(Cells(Y_Row_Start, X_Row_Start), Cells(Y_Row_Start, X_Row_Start)).Select
If ActiveCellDate < SeasonsChange And ActiveCellDate > FirstDayOfYear And SecondHalfYear = False Then
'1. halvår
'If DiffYY = 0 And DiffMM < 6 Then
ThisSeason = ThisSeason + ActiveCell.Value
SeasonGame = SeasonGame + 1
End If
If ActiveCellDate > SeasonsChange And SecondHalfYear = True Then
'2. halvår
'If DiffYY = 0 And DiffMM < 6 Then
ThisSeason = ThisSeason + ActiveCell.Value
SeasonGame = SeasonGame + 1
End If
Else
Range(Cells(Y_Row_Start, 1), Cells(Y_Row_Start, 1)).Select
If Placeholder <> 0 Then
CellYY = Val(Right(ActiveCell.Value, 2))
CellMM = Val(Mid(ActiveCell.Value, 4, 2))
CurrentDate = Format(Now, "dd-mm-yy")
CurrentYY = Val(Right(CurrentDate, 2))
CurrentMM = Val(Mid(CurrentDate, 4, 2))
DiffYY = CurrentYY - CellYY
DiffMM = CurrentMM - CellMM
Range(Cells(Y_Row_Start, X_Row_Start), Cells(Y_Row_Start, X_Row_Start)).Select
If DiffYY = 0 And DiffMM < 6 Then
SeasonGame = SeasonGame + 1
End If
End If
End If
Range(Cells(Y_Row_Start, X_Row_Start), Cells(Y_Row_Start, X_Row_Start)).Select
If Games <= 9 Then
Total = Total + ActiveCell.Value
If Games = 9 Then
NextAverage = ActiveCell.Value
End If
End If
If Games > 9 Then
Flag = 1
End If
Next j
'Generering af output
If SeasonGame = 0 Then SeasonGame = 1
ThisSeason = ThisSeason / SeasonGame
NumberOfGames = Games
If NumberOfGames < 10 Then
Average = (Total) / NumberOfGames
Else
Average = (Total + NextAverage) / 10
End If
Games = 0
Total = 0
Sheets("Resultat").Select
'Range(Cells(2, 1), Cells(2, 1)).Select
'ActiveCell.Value = "Gns. 10"
'Range(Cells(3, 1), Cells(3, 1)).Select
'ActiveCell.Value = "Gns. ½"
'Range(Cells(4, 1), Cells(4, 1)).Select
'ActiveCell.Value = "Gns. næste"
Range(Cells(1, 2), Cells(1, 2)).Select
ActiveCell.Value = "Gns. 10"
Range(Cells(1, 3), Cells(1, 3)).Select
ActiveCell.Value = "Gns. ½"
Range(Cells(1, 4), Cells(1, 4)).Select
ActiveCell.Value = "Gns. næste"
'Range(Cells(2, i), Cells(2, i)).Select
'ActiveCell.Value = Average
'Average = 0
'Range(Cells(3, i), Cells(3, i)).Select
'ActiveCell.Value = ThisSeason
'ThisSeason = 0
'SeasonGame = 0
'Range(Cells(4, i), Cells(4, i)).Select
'ActiveCell.Value = NextAverage
Range(Cells(i, 2), Cells(i, 2)).Select
ActiveCell.Value = Average
Average = 0
Range(Cells(i, 3), Cells(i, 3)).Select
ActiveCell.Value = ThisSeason
ThisSeason = 0
SeasonGame = 0
Range(Cells(i, 4), Cells(i, 4)).Select
ActiveCell.Value = NextAverage
'Range(Cells(X_Row_Stop + 3, i), Cells(X_Row_Stop + 3, i)).Select
'ActiveCell.Value = NextAverage
NextAverage = 0
Flag = 0
Sheets("Resultat_Herrer").Select
Next i
'De to næste linier muliggør Bold´ed resultat
'Rows("" & Y_Row_End + 1 & ":" & Y_Row_End + 3).Select
'Selection.Font.Bold = True
Range("A1").Select
Sheets("Sortering").Select
Columns("A:C").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E34").Select
Columns("F:H").Select
Selection.Sort Key1:=Range("H1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub
