Thema Datum  Von Nutzer Rating
Antwort
01.11.2018 15:29:31 TPM
NotSolved
01.11.2018 18:45:31 Gast13222
NotSolved
01.11.2018 20:03:41 TPM
NotSolved
02.11.2018 10:56:18 TPM
NotSolved
02.11.2018 11:26:18 TPM
NotSolved
02.11.2018 14:21:58 Gast 13222
NotSolved
Rot Werte kummulieren
02.11.2018 15:13:41 Gast 13222
NotSolved

Ansicht des Beitrags:
Von:
Gast 13222
Datum:
02.11.2018 15:13:41
Views:
511
Rating: Antwort:
  Ja
Thema:
Werte kummulieren

für den letzten  Karma-Punkt mach ich es bei einhunderttausendundeinpaarzerqueschten Zeilen

lieber mit Array (benötigt nur 1/5 der Zeit)

Option Explicit
Dim Spalte As Long, Grenzwert As Double, dKum As Double, arrRng() As Variant

Sub aTest()
   Spalte = 1: Grenzwert = 20
   'lösche Ergebnisspalten rechts von
   Columns(Spalte).Offset(, 1).Resize(, 2).Clear
   'ab Zeile 1
   aKumu 1
End Sub

Sub aKumu(Start As Long)
Dim x As Long, y As Long
Dim Rng As Range

   With Columns(Spalte)
      Set Rng = .Range(.Cells(Start), .Cells(.Cells.Count).End(xlUp)).Resize(, 3)
      arrRng = Rng.Value
      
      For x = LBound(arrRng, 1) To UBound(arrRng, 1)
         If IsNumeric(arrRng(x, 1)) And arrRng(x, 1) >= Grenzwert Then
            arrRng(x, 2) = Grenzwert
            'falls erste Zelle bereits größer Grenzwert
            arrRng(x, 3) = arrRng(x, 2) - Grenzwert
         Else
            If IsNumeric(arrRng(x, 1)) Then
               y = aKumIt(x, arrRng(x, 1))
               If y <= UBound(arrRng, 1) Then
                  arrRng(y, 2) = Grenzwert
                  arrRng(y, 3) = dKum - Grenzwert
                  dKum = 0
                  x = y
               Else
                  Exit For
               End If
            End If
         End If
      Next x
      
      .Cells(1).Resize(UBound(arrRng, 1), UBound(arrRng, 2)).Value = arrRng
   
   End With

End Sub

Function aKumIt(Rw As Long, ByVal Wert As Double) As Long
Dim x As Long, Kum As Double

   Kum = Kum + Wert
   For x = Rw + 1 To UBound(arrRng, 1)
      If IsNumeric(arrRng(x, 1)) Then _
         Kum = Kum + arrRng(x, 1)
         If Kum >= Grenzwert Then Exit For
      Next x
      dKum = Kum
      aKumIt = x

End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
01.11.2018 15:29:31 TPM
NotSolved
01.11.2018 18:45:31 Gast13222
NotSolved
01.11.2018 20:03:41 TPM
NotSolved
02.11.2018 10:56:18 TPM
NotSolved
02.11.2018 11:26:18 TPM
NotSolved
02.11.2018 14:21:58 Gast 13222
NotSolved
Rot Werte kummulieren
02.11.2018 15:13:41 Gast 13222
NotSolved