Summenprodukt gefilterter Bereich
27.05.2019 19:11:55
Christian
ich möchte in einer Tabelle abwechselnd nach zwei Kriterien filtern und dabei mit einer Kombination aus Summenprodukt und Zählenwenn, eindeutige Werte bestimmen (es befinden sich Duplikate in der Tabelle). Also eine Nummer referenziert auf zwei Unternummern und ich möchte nur die übergeordnete Nummer ermitteln.
Die Summenprodukt Kombination funktioniert auch weil ich vorher beide Kritieren in verschiedenen Tabellen gespeichert habe. Jetzt möchte ich aber denn SAP Extrakt vereinfachen und beides in eine Tabelle abspeichern.
Mit meiner Formelstruktur erfasse ich zwar die neuen Zeilen im gefilterten Bereich
lngLZeile2 = lngLZeile1 - 1
.Range("H10").Formula = "=SUMPRODUCT(1/COUNTIF(Created!A2:A" & lngLZeile2 & ",Created!A2:A" & lngLZeile2 & "))" 'Created KITs
Option Explicit
Sub Created_()
Dim wsCr As Worksheet
Dim wsOver As Worksheet
Dim wsCl As Worksheet
Dim lngLZeile1 As Long
Dim lngLZeile2 As Long
Dim lngLZeile3 As Long
Dim lngLZeile4 As Long
Dim lngAktZeile As Long
Dim iLSpalte As Integer
Dim iAktSpalte As Integer
Dim strSpalte As String
Set wsCr = TabCr
Set wsCl = TabCl
Set wsOver = TabBoard
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With wsCr
lngLZeile1 = .Range("A2").End(xlDown).Row 'Created
.Range("A" & lngLZeile1).AutoFilter Field:=14, Criteria1:="KIT"
lngLZeile1 = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
lngLZeile2 = lngLZeile1 - 1
.Range("H10").Formula = "=SUMPRODUCT(1/COUNTIF(Created!A2:A" & lngLZeile2 & ",Created!A2:A" _
& lngLZeile2 & "))" 'Created KITs
Application.Calculation = xlCalculationAutomatic
wsOver.Range("H10").Copy
wsOver.Range("H10").PasteSpecial Paste:=xlPasteValues
Application.Calculation = xlCalculationManual
.Range("A" & lngLZeile1).AutoFilter Field:=14, Criteria1:="Other"
lngLZeile1 = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
lngLZeile2 = lngLZeile1 - 1
.Range("I10").Formula = "=SUMPRODUCT(1/COUNTIF(Created!A2:A" & lngLZeile2 & ",Created!A2:A" _
& lngLZeile2 & "))"
Application.Calculation = xlCalculationAutomatic
wsOver.Range("I10").Copy
wsOver.Range("I10").PasteSpecial Paste:=xlPasteValues
End With
wsOver.Range("H10:I10").Copy
wsOver.Range("H10:I10").PasteSpecial Paste:=xlPasteValues
With wsOver
End With
End Sub