Sumprodukt over flere ark

Skal det altid være 2 celler der skal ganges ?
Skal det være ALLE ark til højre for eller ....

Denne funktion kan bruges hvis det drejer sig om alle ark til højre for sumarket og hvis cellerne der skal multipliceres er i et sammenhængende område.
Bruges sådan:
=SumProdAll(A1:A2)
eller
=SumProdAll(A1:c4)


Function SumProdAll(rng)
  Dim Addr1 As String
  Dim Temp As Single
  Dim x As Long, y As Long
  Application.Volatile
  Addr1 = rng.Address
  'find placering af arket med formlen
  For x = 1 To Worksheets.Count
      If Application.Caller.Parent.Name = Worksheets(x).Name Then Exit For
  Next
  x = x + 1
  'For alle ark tilhøjre for (index > formelark)
  For y = x To Worksheets.Count
      'multiplicere og addere
      Temp = Temp + Application.WorksheetFunction.Product(Worksheets(y).Range(Addr1))
  Next
  SumProdAll = Temp
End Function

Tak skal du ha bak.
Du får dine 60 points, hvis jeg da kan finde ud af hvordan man overdrager dem.

Jeg måtte lave en mindre korrektion, idet det var ikke relaterede celler der skulle adderes, samt at summeringen skulle gælde til arket med Navn "X". Sidstnævnte løste jeg dog ved at dette ark altid er fjerde sidst. Ikke særligt elegant men det virker.

Funktionen ser du nedenfor. Du skal være velkommen til at forfine den - specielt hvis du ser at nogle fejlkilder kan opstå.

Ellers må du ha det godt  /hilsen aheiss
________________________________________________
Function SumProdAll(a, b)
  Dim AddrA As String
  Dim AddrB As String
    Dim Temp As Single
  Dim x As Long, y As Long
      Application.Volatile
      AddrA = a.Address
      AddrB = b.Address
  For x = 1 To Worksheets.Count - 3
      If Application.Caller.Parent.Name = Worksheets(x).Name Then Exit For
  Next
  x = x + 1    'For alle ark tilhøjre for (index > formelark)
  For y = x To Worksheets.Count - 3    'multiplicere og addere
      Temp = Temp + Sheets(y).Range(AddrA) * Sheets(y).Range(AddrB)
  Next
  SumProdAll = Temp
End Function

En mindre forbedring.
Denne regner kun på de ark der ligger mellem sumarket og ark X.
Dette betyder at du skal angive navnet på Ark X i apostroffer.

=SumProdAll(A1;A2;"X")


Function SumProdAll(a As Range, b As Range, StopArk As String)
  Dim AddrA As String
  Dim AddrB As String
  Dim Temp As Single
  Dim x As Long, y As Long, s As Long, t As Long
  Application.Volatile
  AddrA = a.Address
  AddrB = b.Address
  For x = 1 To Worksheets.Count
      If Application.Caller.Parent.Name = Worksheets(x).Name Then s = x
      If Worksheets(x).Name = StopArk Then t = x
  Next
  For y = s + 1 To t - 1
      Temp = Temp + Sheets(y).Range(AddrA) * Sheets(y).Range(AddrB)
  Next
  SumProdAll = Temp
End Function

Perfekt.

Tak fra aheiss