Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1536to1540
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zellbereich prüfen und verschieben, dann Summe

Zellbereich prüfen und verschieben, dann Summe
01.02.2017 10:51:54
konstantin
Guten Morgen zusammen,
ich habe eine Excel Liste, in denen Blockweise (1 Spalte, 8 Zeilen) die Inhalte des Zellbereichs aufsummiert werden sollen. Dieser Block soll sich immer eine Zeile nach unten verschieben und NUR die Summe bilden, falls jeder Wert dieser 8 Zellen, größer/gleich einem vorgegebenen Ziel(Bsp. 1,5) liegt.
Mein Ansatz:

Sub BlockFinden()
Dim wsDaten As Worksheet
Dim Level As Double
Dim Tage As Range, BlockEin As Range, BlockAus As Range, Charge As Range
Dim i As Long, j As Long, Zelle As Long
Set wsDaten = tblDaten
With wsDaten
Set Charge = .Range(.Cells(2, 17), .Cells(.Rows.Count, 17).End(xlUp))
With Charge
For i = 2 To .Rows.Count
Set BlockEin = .Range(.Cells(i, j), .Cells(i + 7, j))
If BlockEin.Cells >= "1.5" Then
BlockEin = True
Else: BlockEin = False
End If
If BlockEin = True Then
Level = Sum(BlockEin.Cells.Value)
End If
Next i
End With
End With
End Sub
Vielen Dank für eure Hilfe.
Gruß konstantin

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellbereich prüfen und verschieben, dann Summe
01.02.2017 11:42:47
Fennek
Hallo,
der Code sieh auf den ersten Blick ganz gut, aber wenn man genauer hinsieht, ist da viel "Murx" drin.
Wenn die Zahlen in Spalte B stehen:

for i = 1 to cells(rows.count, "B").end(xlup).row
if worksheetfunction.sum(range(cells(i,"B"), cells(i+7,"B"))) > 1.5 then cells(i,"C") = "ja"
next i
Was ist der Hintergrund der Frage?
mfg
AW: Zellbereich prüfen und verschieben, dann Summe
01.02.2017 11:54:29
konstantin
Hallo,
das Problem ist noch, dass jede einzelne Zelle größer als 1,5 sein soll, nicht nur die gesamte Summe des Bereichs.
Ist für die Uni, zur Berechnung eines Speichers...
Gruß
AW: Zellbereich prüfen und verschieben, dann Summe
01.02.2017 12:09:26
Max2
Hi,
hier Bsp Mappe: https://www.herber.de/bbs/user/111055.xlsm
Kein schöner Code, habe mir nicht allzu viel mühe
damit auf die schnelle gemacht, aber er funktioniert.
Anzeige
AW: Zellbereich prüfen und verschieben, dann Summe
01.02.2017 12:20:27
Max2
Hallo ich nochmal,
kleiner Fehler in beiden Codes
Das Hier ist falsch:

If icount >= 8 Then
If dbl = dvergleich Then
lrow = c.Offset(-8).Row
lrow_2 = c.Offset(-1).Row
icount = 1
Das muss so sein:

If icount >= 8 Then
icount = 0
If dbl = dvergleich Then
lrow = c.Offset(-8).Row
lrow_2 = c.Offset(-1).Row

AW: VBA-Formel
01.02.2017 14:54:50
Fennek
Hallo,
so könnte es auch gehen:

sub T1()
For i = 1 To 8
Cells(i, 2).Formula = "=sumproduct((A" & i & ":A" & i + 7 & ")*(A" & i & ":A" & i + 7 & ">1. _
5))"
Next i
End Sub
mffg
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige