cell1 =GesSum, cella11:CellF11 durchstre

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Uwe,
Du lässt nicht nach :-) finde ich gut.


Sub SummenUndStreichen()
Dim Z As Range
With ThisWorkbook.Worksheets("Tabelle1")
.Range("B1") = 0
For Each Z In .Range("C6:C88")
If Z.Value = .Range("C1").Value Then
.Range("B1") = .Range("B1").Value + .Cells(Z.Row, "B").Value
Z.EntireRow.Range("A1:F1").Font.Strikethrough = True
End If
Next
End With
End Sub

Wir nehmen "Tabelle1" von dieser Arbeitsmappe als Default (alles, was mit einem Punkt anfängt, bezieht sich darauf),
wir setzen die Zelle B1 auf null (da kommt das kumulierte Ergebnis rein. Ein Kumul muss zuerst genullt werden),
für alle Zelle vom Bereich C6:C88,
wenn diese Zelle dieselbe Wert wie C1 hat, dann
die Werte der Zelle in dieselbe Zeile (Z.Row) aber Spalte "B" nehmen und an B1 addieren,
und von dem gesamte Zeile der Zelle (Z.Entirerow) den Bereich A:F in durchgestrichene Schrift setzen.
VG
Yal

Sub Unit() Dim Bereich As Range, Addieren As Range, Zelle As Range Set Suchbereich = Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp)) Set additionsbereich = Suchbereich.Offset(, -1) Cells(1, 1) = WorksheetFunction.SumIf(Suchbereich, Cells(1, 3).Value, additionsbereich) For Each Zelle In Suchbereich If WorksheetFunction.CountIf(Range(Cells(1, 3), Zelle), Zelle.Value) > 1 Then With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 6)).Borders(xlDiagonalDown) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 6)).Borders(xlDiagonalUp) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With End If Next Set Suchbereich = Nothing: Set additionsbereich = Nothing End Sub

Sub Unit() Dim Bereich As Range, Additionsbereich As Range, Zelle As Range Set Suchbereich = Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp)) Set Additionsbereich = Suchbereich.Offset(, -1) Cells(1, 1) = WorksheetFunction.SumIf(Suchbereich, Cells(1, 3).Value, Additionsbereich) For Each Zelle In Suchbereich If WorksheetFunction.CountIf(Range(Cells(1, 3), Zelle), Zelle.Value) > 1 Then With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 6)).Borders(xlDiagonalDown) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With With Range(Cells(Zelle.Row, 1), Cells(Zelle.Row, 6)).Borders(xlDiagonalUp) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlThin End With End If Next Set Suchbereich = Nothing: Set Additionsbereich = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

cell1 =GesSum, cella11:CellF11 durchstre

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread