AW: Formel per Makro runterziehen
05.11.2019 11:23:17
RO
Hi, danke für Antwort,
das ist die komplete Makro...
Sub CS_Masterliste()
' Nachricht Makrostart
If MsgBox("Ist der aktuelleste Datenbank-Export in dieser Datei hinterlegt", vbYesNo) = vbNo _
Then
MsgBox "Bitte erst den Datenbank-Export über den DB_Overview laden, öffnen & via Button - _
Abfrage_Export_importieren- einfügen! Achtung Text in Spalten im Abfrage_Export nicht vergessen!"
Exit Sub
Else
' Bildschirmaktivität aus
Application.ScreenUpdating = False
'---------------------Vorbereitung---------------------------------------
' Variable definieren
Dim dDate, dTime As Date
Dim AnzahlL As Integer
'Dim Filtermonate As Variant
'Dim Filtermonat1, Filtermonat2, Filtermonat3, Filtermonat4 As Variant
' Abfrage zum Datenstand
Sheets("Makros").Select
dDate = Cells(11, 16)
dTime = Cells(12, 16)
' Variablebelegung für Jahresvorgabe siehe Tabellenblatt Makros Zelle F9
Sheets("Makros").Select
ActiveSheet.Calculate
Jahresvorgabe = Cells(12, 6)
Monatsvorgabe = Cells(13, 6)
' Variablebelegung für auszuwertende Monate Tabellenblatt Makros Zelle F13
'Filtermonate = Array(Worksheets("Makros").Range("H10:H13").Value)
Filtermonat4 = Cells(10, 8)
Filtermonat3 = Cells(11, 8)
Filtermonat2 = Cells(12, 8)
Filtermonat1 = Cells(13, 8)
'Filtermonate = Array(Filtermonat1, Filtermonat2, Filtermonat3, Filtermonat4)
' Blatt CS Datenbereinigung -------(letzte Beschriebene Spalte auslesen)
Sheets("CS_Masterliste").Select
Columns("A:AG").EntireColumn.Hidden = False
With Sheets("CS_Masterliste")
If .FilterMode Then
.ShowAllData
End If
End With
Range("A10:AG60000").Select
Selection.ClearContents
' Tabelle Abfrage_Export alle Daten anzeigen
Sheets("Abfrage_Export_DE").Select
Columns("A:CF").EntireColumn.Hidden = False
With Sheets("Abfrage_Export_DE")
If .FilterMode Then
.ShowAllData
End If
End With
'---------------------Filtern---------------------------------------
' Tabelle Abfrage_Export nach FormelD bewertete Reporte Filtern
ActiveSheet.Range("$A$4:$A$6000").AutoFilter Field:=1, Criteria1:="=FD", _
Operator:=xlOr
' Tabelle Abfrage_Export für Masterliste Filtern (alle Werke)
ActiveSheet.Range("$A$4:$BA$6000").AutoFilter Field:=53, Criteria1:=Array( _
"MZ61", "MZ62", "MZ64", "MZ66", "MZ67", "MZ69"), Operator:=xlFilterValues
' Tabelle Abfrage_Export nach Auswertemonaten filtern
If Monatsvorgabe = "Januar" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"1", "12", "11"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Februar" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"2", "1", "12"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "März" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"3", "2", "1"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "April" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"4", "3", "2", "1"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Mai" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"5", "4", "3", "2"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Juni" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"6", "5", "4", "3"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Juli" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"7", "6", "5", "4"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "August" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"8", "7", "6", "5"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "September" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"9", "8", "7", "6"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Oktober" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"10", "9", "8", "7"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "November" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"11", "10", "9", "8"), Operator:=xlFilterValues
Else
If Monatsvorgabe = "Dezember" Then
ActiveSheet.Range("$A$4:$BO$6000").AutoFilter Field:=67, Criteria1:=Array( _
"12", "11", "10", "9"), Operator:=xlFilterValues
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
'ActiveSheet.Range("$A$4:$BO$60000").AutoFilter Field:=67, Criteria1:= _
Filtermonat1, Criteria2:=Filtermonat2, Criteria3:=Filtermonat3, Criteria4:=Filtermonat4, Operatort:=x10r
' Tabelle Abfrage_Export_DE nach Jahr filtern
If Jahresvorgabe = "2017" Then
ActiveSheet.Range("$A$4:$CD$6000").AutoFilter Field:=82, Criteria1:="=2017", _
Operator:=xlOr
Else
If Jahresvorgabe = "2018" Then
ActiveSheet.Range("$A$1:$CD$6000").AutoFilter Field:=82, Criteria1:="=2018", _
Operator:=xlOr
Else
If Jahresvorgabe = "2019" Then
ActiveSheet.Range("$A$1:$CD$6000").AutoFilter Field:=82, Criteria1:="=2019", _
Operator:=xlOr
Else
If Jahresvorgabe = "2020" Then
ActiveSheet.Range("$A$1:$CD$6000").AutoFilter Field:=82, Criteria1:="=2020", _
Operator:=xlOr
End If
End If
End If
End If
'ActiveSheet.Range("$A$4:$CD$6000").AutoFilter Field:=17, Criteria1:=Jahresvorgabe, _
Operator:=xlFilterValues
'---------------------Übertrag der Filterung---------------------------- _
Sheets("Abfrage_Export_DE").Select
Range("AX5:AX60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("I10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("B5:B60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("J10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("C5:C60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("K10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("D5:D60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("L10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("I5:I60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("M10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("G5:G60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("N10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("H5:H60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("O10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("J5:J60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("P10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("BA5:BA60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("Q10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("AZ5:AZ60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("R10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("K5:M60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("S10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("N5:N60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("V10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("P5:P60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("W10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("Q5:Q60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("X10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("AE5:AE60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("Y10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("R5:R60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("Z10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("BT5:BT60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("AA10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("BU5:BU60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("AB10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("AP5:AP60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("AC10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("AQ5:AQ60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("AD10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("AR5:AR60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("AE10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("AS5:AS60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("AF10").Select
ActiveSheet.Paste
Sheets("Abfrage_Export_DE").Select
Range("AO5:AO60000").Select
Selection.Copy
Sheets("CS_Masterliste").Select
Range("AG10").Select
ActiveSheet.Paste
' letzte beschrieben Zeile ermitteln
letztezeile1 = ActiveSheet.Cells(60000, 10).End(xlUp).Row
'Formeln bis zur letzten Beschrieben Zeile einfügen
Range("A10").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[10]),"""",MONTH(RC[21]))"
Range("B10").Select
ActiveCell.FormulaR1C1 = "=IF(AND(RC9""A"",RC22""""), 1,"""")"
Range("C10").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,IF(RC23=""kein CS durchgeführt"" _
,"""",IF(RC23=""undecided"","""",1)),"""")"
Range("D10").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""","""",IF(RC134.49,1,IF(RC[7]=""o.Bew."",1,""""))) _
Range("G10").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,IF(RC[16]=""kein Crosscheck _
durchgeführt"","""",IF(RC[16]=""undecided"","""",1)),"""")"
Range("A10:G10").Select
Selection.AutoFill Destination:=Range("A10:G" & letztezeile2), Type:= _
xlFillDefault
'nach Bewertungsdatum aufsteigend sortieren
ActiveWorkbook.Worksheets("CS_Masterliste").AutoFilter.Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("CS_Masterliste").AutoFilter.Sort.SortFields. _
Add Key:= _
Range("V9"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("CS_Masterliste").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Laufende Nummer einfügen
Range("H10").Value = "1"
Range("H11").Select
ActiveCell.FormulaR1C1 = "=IF(ISBLANK(RC[11]),"""",R[-1]C+1)"
Range("H11").Select
Selection.AutoFill Destination:=Range("H11:H" & letztezeile2), Type: _
=xlFillDefault
ActiveSheet.Calculate
' Variablenbelegung für Anzahl der Reporte im Bezugszeitraum & Datum/Uhrzeit des _
Datenstandes in Tabellenblatt Masterliste eintragen
AnzahlL = WorksheetFunction.CountA(Range("J10:J" & letztezeile2))
Range("H3").Value = dDate
Range("H5").Value = dTime
' Anzahl der Reporte im Bezugszeitraum & Datum des Datenstandes bei letzter Makroausführung _
im Tabellenblatt Makros eintragen
Sheets("Makros").Select
Range("F10").Value = "Reporte: " & AnzahlL
Range("G10").Value = "Datenstand: " & dDate
End If
' Nachricht Makroende
MsgBox "Vorgang abgeschlossen. Bitte die Masterliste auf Fehler prüfen!"
End Sub
Range("A10:G10").Select
Selection.AutoFill Destination:=Range("A10:G" & letztezeile2), Type:=xlFillDefault