06. januar 2007 - 00:05Der er
10 kommentarer og 1 løsning
Sumfunktion med flere opslag og sum over flere ark
Hej
Jeg har tidligere fået nedenstående funktion men skal nu bruge en funktion der kan lidt mere.
------------------
Function SumSpecial(Lookup_value As String, col_index_num As Byte) Dim t, rk, ws, mySum, Fra, Til
Application.Volatile
Fra = Sheets("Output").Range("Monthfrom").Value + 1: Til = Sheets("Output").Range("Monthto").Value + 1
For ws = Fra To Til For t = 1 To Sheets(ws).Range("A200").End(xlUp).Row If Sheets(ws).Cells(t, 1).Value = Lookup_value Then mySum = mySum + Sheets(ws).Cells(t, col_index_num) Next Next
SumSpecial = mySum
End Function
Funktionen finder rækken der skal summeres fra på baggrund af en opslagsværdi (kontotekst) og summerer kolonnerne angivet ved den fundne række og en fra kolonne og en til kolonne (der indsættes i funktionen) i alle de underliggende ark (der kommer hele tiden flere ark til som skal indgå i summen).
Den ny funktion skal kunne lidt mere.
Funktionen skal kunne: - finde rækken der skal summeres fra på baggrund af en opslagsværdi (kontotekst) - skal kunne summere over alle de underliggende ark (alle ark der ikke indeholder funktionen selv). - Skal kunne summere de seneste 12 måneders tal (12 kolonner fra hvert afdelingsark – de un-derliggende ark) fra en given dato og 12 måneder tilbage. - Hvert afdelingsark indeholder mere end et års tal og der kommer hver måned en ny kolonne til.
Projektmappen indeholder: - 1 sumark - Et uendeligt antal afdelingsark
Hvert afdelingsark indeholder: - En kolonne A der indeholder kontonavn - Kolonne B til ? der indeholder hver måneds tal - En række hvor der i kolonne A står Date og hvor der fra kolonne B til ? en angivet måned og år (måned og år har ikke nødvendigvis samme udgangspunkt i alle afdelingsarkene – marts 2006 står i rækken benævnt Date men kan være indsat i forskellige kolonner i afdelingsarkene).
Er der en der kan hjælpe mig med et ombygge ovenstående funktion så den kan ovenstående?
Denne forudsætter dine måned/år er indsat som tekst fx. jan06
Function TotalSum(Konto, Måned, År) Application.Volatile Dim ws Dim t, Drk, Krk, FraKol, TilKol, ArkSum For ws = 2 To Sheets.Count
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = "Date" Then Drk = t: Exit For Next
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = Konto Then Krk = t: Exit For Next
For t = 2 To Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column If Left(Sheets(ws).Cells(Drk, t), 3) = Måned And Right(Sheets(ws).Cells(Drk, t), 2) = År Then FraKol = t: TilKol = FraKol + 11 End If Next
For t = FraKol To TilKol ArkSum = ArkSum + Sheets(ws).Cells(Krk, t) Next
Jeg har rettet lidt i funktionen, men kun navne og den virker næsten som jeg havde tænkt mig, men der er en lille ting som går galt.
Hvis et ark ikke indeholder den dato, der skal summeres fra (FraKol) skal funktionen søge efter den måned der kommer efter og så kun summerer de 11 måneder o.s.v.
Eksempelvis hvis jeg vil have summeret fra jan 06 til dec 06 og nogle af mine underliggende ark ikke indeholder jan 06 (afdelingen er startet senere), så skal funktionen kun summerer dette afdelingsark fra Feb 06 og til Dec 06 (11 måneder) ligeledes hvis en afdeling først er startet i Jul 06 summeres kun 6 måneder.
Kan det indbygges i den nuværende funktion?
Her er den jeg har rettet lidt i:
Function TotalSum(Account, Month, Year) Application.Volatile Dim ws Dim t, Drk, Krk, FraKol, TilKol, ArkSum
For ws = 2 To Sheets.Count
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = "Month name" Then Drk = t: Exit For Next
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = Account Then Krk = t: Exit For Next
For t = 2 To Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column If Left(Sheets(ws).Cells(Drk, t), 3) = Month And Right(Sheets(ws).Cells(Drk, t), 2) = Year Then FraKol = t: TilKol = FraKol + 11 End If Next
For t = FraKol To TilKol ArkSum = ArkSum + Sheets(ws).Cells(Krk, t) Next
Prøv om denne dur, blev nødt til at ændre input som du kan se =Tsum("C";"jan";"dec";"06")
Function TSum(Konto, FraMåned, TilMåned, År) Application.Volatile Dim ws, t, Drk, Krk, FraKol, TilKol, ArkSum
For ws = 2 To Sheets.Count
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = "Date" Then Drk = t: Exit For Next
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = Konto Then Krk = t: Exit For Next
For t = 2 To Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column If Left(Sheets(ws).Cells(Drk, t), 3) = FraMåned And Right(Sheets(ws).Cells(Drk, t), 2) = År Then FraKol = t: Exit For End If Next If FraKol = "" Then FraKol = 2
For t = 2 To Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column If Left(Sheets(ws).Cells(Drk, t), 3) = TilMåned And Right(Sheets(ws).Cells(Drk, t), 2) = År Then TilKol = t: Exit For End If Next If TilKol = "" Then TilKol = Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column
Function TSum(Konto, FraMåned, FraÅr, TilMåned, TilÅr) Application.Volatile Dim ws, t, Drk, Krk, FraKol, TilKol, ArkSum
For ws = 2 To Sheets.Count
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = "Date" Then Drk = t: Exit For Next
For t = 1 To Sheets(ws).Cells(65500, 1).End(xlUp).Row If Sheets(ws).Cells(t, 1) = Konto Then Krk = t: Exit For Next
For t = 2 To Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column If Left(Sheets(ws).Cells(Drk, t), 3) = FraMåned And Right(Sheets(ws).Cells(Drk, t), 2) = FraÅr Then FraKol = t: Exit For End If Next If FraKol = "" Then FraKol = 2
For t = 2 To Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column If Left(Sheets(ws).Cells(Drk, t), 3) = TilMåned And Right(Sheets(ws).Cells(Drk, t), 2) = TilÅr Then TilKol = t: Exit For End If Next If TilKol = "" Then TilKol = Sheets(ws).Cells(Drk, 256).End(xlToLeft).Column
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.
