AW: Nachfrage
01.05.2020 10:56:27
Fred
Hallo Werner,
das was "Probleme" bereitet ist nur der Vorgang der "Datumswerte",- dies müsste unbedingt korrigiert werden.
Ja, im Makro werden noch weitere Unikatlisten erstellt (aus anderen Quellblättern). Um die Mappe entsprechend klein zu halten habe ich mich auf das wesenliche beschränkt.
Die Datums-Unikatliste wird nicht sortiert.
Die "anderen" Unikatlisten werden sortiert ...
Makro
Public Sub Unikate_1()
Dim avntValues As Variant, vntItem As Variant
Dim objDictionary As Object
Worksheets("Head").Range("AA2:AP5000").ClearContents
With Worksheets("Tage_b")
avntValues = .Range("A10:A50").Value
End With
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
With objDictionary
For Each vntItem In avntValues
.Item(Key:=vntItem) = vbNullString
Next
Worksheets("Head").Cells(2, 27).Resize(.Count, 1).Value = Application.Transpose(.Keys)
Worksheets("Head").Cells(1, 27).Value = "Datum"
End With
Set objDictionary = Nothing
' *********************** Wettbewerb ********************************
With Worksheets("Spiele_b")
avntValues = .Range("C10:C300").Value
End With
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
With objDictionary
For Each vntItem In avntValues
.Item(Key:=vntItem) = vbNullString
Next
Worksheets("Head").Cells(2, 28).Resize(.Count, 1).Value = Application.Transpose(.Keys)
Worksheets("Head").Cells(1, 28).Value = "Wettbewerb"
End With
Set objDictionary = Nothing
Worksheets("Head").Activate
Worksheets("Head").Range("AC2").FormulaLocal = "=ZÄHLENWENN(accountStatement!$O$6:$O$30000;Head! _
AB2)"
LZ_EX77 = Sheets("Head").Cells(Rows.Count, 28).End(xlUp).Row
With Worksheets("Head") ' Formeln werden nach unten gezogen
.Range("AC2:AD2").AutoFill Destination:=Range("AC2:AD" & LZ_EX77), Type:=xlFillDefault
End With
' Werte statt Formeln
With Sheets("Head").UsedRange
.Cells = .Cells.Value
End With
'Sortieren
'Parameter Land
LZ_EX100 = Sheets("Head").Cells(Rows.Count, 28).End(xlUp).Row
strBereich = "AB1:AC" & LZ_EX100
strSpalte = "AB" ' nach dieser Spalte sortieren
With ActiveSheet
Range(strBereich).Sort _
Key1:=Range(strSpalte & "1"), Order1:=xlAscending, _
Header:=xlYes
End With
' *********************** Markt ********************************
With Worksheets("accountStatement")
avntValues = .Range("Q6:Q30000").Value
End With
Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
With objDictionary
For Each vntItem In avntValues
.Item(Key:=vntItem) = vbNullString
Next
Worksheets("Head").Cells(2, 31).Resize(.Count, 1).Value = Application.Transpose(.Keys)
Worksheets("Head").Cells(1, 31).Value = "Markt"
End With
Set objDictionary = Nothing
Worksheets("Head").Activate
Worksheets("Head").Range("AF2").FormulaLocal = "=ZÄHLENWENN(accountStatement!$Q$6:$Q$30000;Head! _
AE2)"
LZ_EX177 = Sheets("Head").Cells(Rows.Count, 31).End(xlUp).Row
With Worksheets("Head") ' Formeln werden nach unten gezogen
.Range("AF2:AG2").AutoFill Destination:=Range("AF2:AG" & LZ_EX177), Type:=xlFillDefault
End With
' Werte statt Formeln
With Sheets("Head").UsedRange
.Cells = .Cells.Value
End With
'Sortieren
'Parameter Land
LZ_EX1100 = Sheets("Head").Cells(Rows.Count, 31).End(xlUp).Row
strBereich = "AE1:AF" & LZ_EX1100
strSpalte = "AE" ' nach dieser Spalte sortieren
With ActiveSheet
Range(strBereich).Sort _
Key1:=Range(strSpalte & "1"), Order1:=xlAscending, _
Header:=xlYes
End With
End Sub
Wenn es nötig ist, könnte auch der Vorgang mit der Unikatliste "Datum" getrennt (im anderen Makro) von den anderen Unikatlisten geschehen.
Gruß
Fred