|
Hallo
ohne mir alle vorherigen AW's angeschaut zu haben hat es mich gejuckt den von Select bereinigten Code mal so umzuschreiben wie er für mich sinnvoll (praxisgerecht) ist. Ich liebe es Aufgaben in einzelne Abschnitte zu unterteilen und die seperaten Makros ins Hauptprogramm als Call einzubauen. Der Vorteil ist, so kann man jedes Makro intensiv für sich testen und weiss das es Okay ist!!
Die Sache ist programmtechnisch erledigt, und bei Fehlersuche kann man die geprüften Makros als Fehlerursache ausschliessen!
Ob Jörg sich mit dieser Idee anfreunden kann muss er entscheiden. Und natürlich prüfen ob der Code in allen Details korrekt gekürzt wurde? Bei der Laenge kann ich nicht ausschliessen etwas übersehen zu haben. Statt Sheet.Select ist es besser mit With Klammern zu arbeiten (den Punkt vor Cells/Range nicht vergessen!). Das hat er noch nicht drauf. An meinem Code kann er aber lernen wie man das in der Praxis elegant lösen kann. Bei For Next habe ich alle überflüssigen Sheet.Select gelöscht!! Nun bin ich mal gespannt auf seine Rückmeldung ....
mfg Nobody
Public WSZiel As Worksheet, wks As Worksheet
Public WBQuelle As Workbook, loLetzte1 As Long
Sub Baustellenkontrollen()
Dim WBZiel As Workbook, ExportDatei As Variant
Set WBZiel = ThisWorkbook
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Sheets("V03").Select
Cells.ClearContents
With ActiveSheet
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
.UsedRange.AutoFilter
End If
End With
Sheets("V03 erweitert").Select
Cells.ClearContents
With ActiveSheet
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
Else
.UsedRange.AutoFilter
End If
End With
'Beschriftung (in eigenen Modulen)
'** Bitte Ausdruck in With Klammer beachten!!
'** ThisWorkbook oder "AktivWorkbook" ???
'** bitte prüfen und selbst festlegen
'** "AktivWorkbook" gilt erst NACH OPEN ExportDatei!!
'** ggf. die Blatt Eintichten Zeile NACH OPEN verschieben!!
Call Blatt_V03_einrichten
Call Blatt_V0405_einrichten
Call Blatt_V03_erweitert_einrichten
Call Blatt_Auswertung_Text_einrichten
Call Blatt_Auswertung_Formeln_einrichten
Call Blatt_Aufschlüsselung_einrichten
'Datei öffnen, Dialog anbieten
ExportDatei = Application.GetOpenFilename("Excel-Dateien, *.xlsx*", , "Bitte die Datei zum Kopieren öffnen ..")
ExportDatei = CStr(ExportDatei)
If ExportDatei = False Then Exit Sub 'oder Empty ??
If ExportDatei = "Falsch" Then Exit Sub '???
'öffnen der ausgewählten Datei
Set WBQuelle = Workbooks.Open(ExportDatei)
'kopieren des Blattinhaltes und Schließen der Quell-Datei
With WBQuelle
.Sheets("V03").Range("A1:KT9000").Copy WBZiel.Sheets("V03").Range("A1")
.Sheets("V03 erweitert").Range("A1:KT9000").Copy WBZiel.Sheets("V03 erweitert").Range("A1")
.Sheets("V0405").Range("A1:KT9000").Copy WBZiel.Sheets("V0405").Range("A1")
.Close savechanges:=False
End With
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
'Berechnungen
'Filtern
For PD = 1 To 2
If PD = 1 Then ORT = "*BLN*"
If PD = 2 Then ORT = "*CS*"
If PD = 3 Then ORT = "*NSZ*"
If PD = 4 Then ORT = "*SWE*"
If PD = 5 Then ORT = "*I.NP-O-F*"
If PD = 6 Then ORT = "*I.NA-O-R*"
letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
'************************** TEMP 1**************************************************
Dim Datum1 As String, Datum2 As String
Datum1 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 3).Text, "=")(1))))
Datum2 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 4).Text, "=")(1))))
'*** Dieser befehl funktioniert so NICHT !!!
'ThisWorkbook.Worksheets("V03").Activate
'Nach Netzen filtern
'Windows("Deine Datei.xlsm").Activate 'deinen Namen angeben oder so:
Windows(ThisWorkbook.Name).Activate
Worksheets("V03").Activate
Selection.AutoFilter Field:=13, Criteria1:="*BLN*", Operator:=xlOr
Selection.AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
Worksheets("V03").Range("M1").AutoFilter Field:=16, VisibleDropDown:=False
'ID finden und kopieren
Dim Zeilennr As Integer
Dim Spaltennr As Integer
Dim ID As String
Dim maxZeilen As Integer
Dim maxSpalten As Integer
'Dim AktZeilennr as Integer
Sheets("TEMP1").Select
Cells.ClearContents
'** Bitte prüfen ob der gekürzte Copy Vorgang korrekt funktioniert !!
'** wiederholt sich noch dreimal mit anderen Sheets. Alles korrekt???
Sheets("V03").Cells.Copy
Cells.Select
ActiveSheet.Paste
maxZeilen = Application.WorksheetFunction.CountA(Range("A:A"))
'** Wenn in For Next der Blattname davorsteht ist das Sheet umschalten NICHT erforderlich
'** Sheet Select von mir gelöscht
For Zeilennr = 2 To maxZeilen
For Spaltennr = 27 To 72
If Cells(Zeilennr, Spaltennr) = "nein" Then
ID = Cells(Zeilennr, 1)
' Max. Eintrag in 'Aufschlüsselung, Spalte xx ermitteln
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 24) = ID
Next Spaltennr
Next Zeilennr
'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
'letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row
'************************** TEMP 2**************************************************
'Filtern
Dim Datum3 As String, Datum4 As String
Datum3 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 3).Text, "=")(1))))
Datum4 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 4).Text, "=")(1))))
'Nach Netzen filtern
Worksheets("V03 erweitert").Activate
Sheets("TEMP1").AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
'Überschrift Text einrichten (loletzte)
Call Blatt_Aufschlüsselung_einrichten_M1
'ID finden und kopieren
'Dim Zeilennr As Integer
'Dim Spaltennr As Integer
'Dim ID As String
'Dim maxZeilen As Integer
'Dim maxSpalten As Integer
'Dim AktZeilennr as Integer
Sheets("TEMP2").Select
Sheets("TEMP2").ClearContents
Sheets("V03 erweitert").Cells.Copy
Cells.Select
ActiveSheet.Paste
maxZeilen = Application.WorksheetFunction.CountA(Range("A:A"))
For Zeilennr = 2 To maxZeilen
For Spaltennr = 26 To 76
If Cells(Zeilennr, Spaltennr) = "nein" Then
ID = Cells(Zeilennr, 1)
' Max. Eintrag in 'Aufschlüsselung, Spalte xx ermitteln
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 23) = ID
Next Spaltennr
Next Zeilennr
'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
'************************** TEMP 3**************************************************
'Filtern
Dim Datum5 As String, Datum6 As String
Datum5 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 3).Text, "=")(1))))
Datum6 = CStr(CLng(CDate(Split(Worksheets("Eingabe").Cells(5, 4).Text, "=")(1))))
ThisWorkbook.Worksheets("V0405").Activate
'Nach Netzen filtern
ThisWorkbook.Worksheets("V0405").Activate
Sheets("TEMP2").AutoFilter Field:=13, Criteria1:=ORT, Operator:=xlOr
'Überschrift Text einrichten (loletzte)
Blatt_Aufschlüsselung_einrichten_M2
'ID finden und kopieren
'Dim Zeilennr As Integer
'Dim Spaltennr As Integer
'Dim ID As String
'Dim maxZeilen As Integer
'Dim maxSpalten As Integer
'Dim AktZeilennr as Integer
Sheets("TEMP3").Select
Sheets("TEMP3").ClearContents
Sheets("V0405").Cells.Copy
Cells.Select
ActiveSheet.Paste
maxZeilen = Application.WorksheetFunction.CountA(Range("A:A"))
For Zeilennr = 2 To maxZeilen
For Spaltennr = 24 To 37
If Cells(Zeilennr, Spaltennr) = "nein" Then
ID = Cells(Zeilennr, 1)
' Max. Eintrag in 'Aufschlüsselung, Spalte xx ermitteln
Sheets("Aufschlüsselung").Cells(AktZeilennr, Spaltennr - 21) = ID
Next Spaltennr
Next Zeilennr
'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
letztezeile = Sheets("Aufschlüsselung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
Next PD
Application.EnableEvents = True
End Sub
'###########################################################################3
'Modul2:
Sub Blatt_V03_einrichten()
With ThisWorkbook.Sheets("V03")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("L1").Values = "suche ""("""
.Range("M1").Values = "Kürzel"
.Range("N1").Values = "Abk"
.Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("L2").FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
.Range("L2").AutoFill Destination:=.Range("L2:L" & loLetzte)
.Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("M2").FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
.Range("M2").AutoFill Destination:=.Range("M2:M" & loLetzte)
.Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("N2").Formula2R1C1 = "=left(RC[-1],8)"
.Range("N2").AutoFill Destination:=.Range("N2:N" & loLetzte)
End With
End With
Sub Blatt_V03_erweitert_einrichten()
With WBZiel.Sheets("V03 erweitert")
loLetzte1 = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("L1").Values = "suche ""("""
.Range("M1").Values = "Kürzel"
.Range("N1").Values = "Abk"
.Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("L2").FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
.Range("L2").AutoFill Destination:=.Range("L2:L" & loLetzte1)
.Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("M2").FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
.Range("M2").AutoFill Destination:=.Range("M2:M" & loLetzte1)
.Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("N2").Formula2R1C1 = "=left(RC[-1],8)"
.Range("N2").AutoFill Destination:=.Range("N2:N" & loLetzte1)
End With
End Sub
'###########################################################################3
'Modul3:
Sub Blatt_V0405_einrichten()
With ThisWorkbook.Sheets("V0405")
loLetzte2 = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("L1").Values = "suche ""("""
.Range("M1").Values = "Kürzel"
.Range("N1").Values = "Abk"
.Columns("L:L").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("L2").FormulaR1C1 = "=IFERROR(SEARCH(""("",RC[-1]),0)"
.Range("L2").AutoFill Destination:=.Range("L2:L" & loLetzte2)
.Columns("M:M").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("M2").FormulaR1C1 = "=TRIM(IF(RC[-1]=0,RC[-2],MID(RC[-2],1,RC[-1]-1)))"
.Range("M2").AutoFill Destination:=.Range("M2:M" & loLetzte2)
.Columns("N:N").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("N2").Formula2R1C1 = "=left(RC[-1],8)"
.Range("N2").AutoFill Destination:=.Range("N2:N" & loLetzte2)
End With
End Sub
'###########################################################################3
'Modul4:
'** ThisWorkbook oder AktivWorkbook???
'** bitte prüfen und selbst festlegen
'** AktivWorkbook erst nach Open ExportDatei!!
Sub Blatt_Auswertung_Text_einrichten()
'nur Text in Zellen einrichten
With ThisWorkbook.Sheets("Auswertung") '** This oder Activ Workbbok??
.Cells.ClearContents
'** .Range A1 korrekt??? war vorher ActiveCell!!
.Range("A1").Values = "Rückmeldungen (Gesamtpositionen)"
.Range("B4").Values = "PD"
.Range("C4").Values = "V03"
.Range("D4").Values = "V03 erw."
.Range("E4").Values = "V05"
.Range("F4").Values = "Gesamt"
.Range("B5").Values = "BLN"
.Range("B6").Values = "CS"
.Range("B7").Values = "NSZ"
.Range("B8").Values = "SWE"
.Range("B9").Values = "I.NP-O-F"
.Range("B10").Values = "I.NA-O-R"
.Range("B11").Values = "Summe"
.Range("B15:E15").Values = """Nein""-Rückmeldungen V03"
.Range("B17").Values = "PD"
.Range("B18").Values = "BLN"
.Range("B19").Values = "CS"
.Range("B20").Values = "NSZ"
.Range("B21").Values = "SWE"
.Range("B22").Values = "I.NP-O-F"
.Range("B23").Values = "I.NA-O-R"
.Range("B24").Values = "Summe"
.Range("C17").Values = "bauko_3_1_1"
.Range("D17").Values = "bauko_3_1_2"
.Range("E17").Values = "bauko_3_1_3"
.Range("F17").Values = "bauko_3_2_1"
.Range("G17").Values = "bauko_3_2_2"
.Range("H17").Values = "bauko_3_2_3"
.Range("I17").Values = "bauko_3_2_4"
.Range("J17").Values = "bauko_3_2_5"
.Range("K17").Values = "bauko_3_3_1"
.Range("L17").Values = "bauko_3_3_2"
.Range("M17").Values = "bauko_3_3_3"
.Range("N17").Values = "bauko_3_3_4"
.Range("O17").Values = "bauko_3_3_5"
.Range("P17").Values = "bauko_3_3_6"
.Range("Q17").Values = "bauko_3_3_7"
.Range("R17").Values = "bauko_3_3_8"
.Range("S17").Values = "bauko_3_4_1"
.Range("T17").Values = "bauko_3_4_2"
.Range("U17").Values = "bauko_3_4_2_1"
.Range("V17").Values = "bauko_3_4_3"
.Range("W17").Values = "bauko_3_4_3_1"
.Range("X17").Values = "bauko_3_4_3_2"
.Range("Y17").Values = "bauko_3_4_3_3"
.Range("Z17").Values = "bauko_3_4_4"
.Range("AA17").Values = "bauko_3_4_4_1"
.Range("AB17").Values = "bauko_3_4_4_2"
.Range("AC17").Values = "bauko_3_4_4_3"
.Range("AD17").Values = "bauko_3_4_4_4"
.Range("AE17").Values = "bauko_3_4_4_5"
.Range("AF17").Values = "bauko_3_4_5"
.Range("AG17").Values = "bauko_3_4_5_1"
.Range("AH17").Values = "bauko_3_4_5_2"
.Range("AI17").Values = "bauko_3_4_5_3"
.Range("AJ17").Values = "bauko_3_4_6_1"
.Range("AK17").Values = "bauko_3_4_6_2"
.Range("AL17").Values = "bauko_3_4_6_3"
.Range("AM17").Values = "bauko_3_4_6_4"
.Range("AN17").Values = "bauko_3_4_6_5"
.Range("AO17").Values = "bauko_3_4_6_6"
.Range("AP17").Values = "bauko_4_1"
.Range("AQ17").Values = "bauko_4_2"
.Range("AR17").Values = "bauko_4_3"
.Range("AS17").Values = "bauko_4_4"
.Range("AT17").Values = "bauko_4_5"
.Range("AU17").Values = "bauko_4_6"
.Range("AV17").Values = "bauko_5_1"
.Range("B28").Values = "PD"
.Range("B29").Values = "BLN"
.Range("B30").Values = "CS"
.Range("B31").Values = "NSZ"
.Range("B32").Values = "SWE"
.Range("B33").Values = "I.NP-O-F"
.Range("B34").Values = "I.NA-O-R"
.Range("B35").Values = "Summe"
.Range("C28").Values = "bauko_3_1_1"
.Range("D28").Values = "bauko_3_1_2"
.Range("E28").Values = "bauko_3_1_3"
.Range("F28").Values = "bauko_3_2_1"
.Range("G28").Values = "bauko_3_2_2"
.Range("H28").Values = "bauko_3_2_3"
.Range("I28").Values = "bauko_3_2_4"
.Range("J28").Values = "bauko_3_2_5"
.Range("K28").Values = "bauko_3_3_1"
.Range("L28").Values = "bauko_3_3_2"
.Range("M28").Values = "bauko_3_3_3"
.Range("N28").Values = "bauko_3_3_4"
.Range("O28").Values = "bauko_3_3_5"
.Range("P28").Values = "bauko_3_3_6"
.Range("Q28").Values = "bauko_3_3_7"
.Range("R28").Values = "bauko_3_3_8"
.Range("S28").Values = "bauko_3_4_1"
.Range("T28").Values = "bauko_3_4_2"
.Range("U28").Values = "bauko_3_4_2_1"
.Range("V28").Values = "bauko_3_4_3"
.Range("W28").Values = "bauko_3_4_3_1"
.Range("X28").Values = "bauko_3_4_3_2"
.Range("Y28").Values = "bauko_3_4_3_3"
.Range("Z28").Values = "bauko_3_4_4"
.Range("AA28").Values = "bauko_3_4_4_1"
.Range("AB28").Values = "bauko_3_4_4_2"
.Range("AC28").Values = "bauko_3_4_4_3"
.Range("AD28").Values = "bauko_3_4_4_4"
.Range("AE28").Values = "bauko_3_4_4_5"
.Range("AF28").Values = "bauko_3_4_5"
.Range("AG28").Values = "bauko_3_4_5_1"
.Range("AH28").Values = "bauko_3_4_5_2"
.Range("AI28").Values = "bauko_3_4_5_3"
.Range("AJ28").Values = "bauko_3_4_6_1"
.Range("AK28").Values = "bauko_3_4_6_2"
.Range("AL28").Values = "bauko_3_4_6_3"
.Range("AM28").Values = "bauko_3_4_6_4"
.Range("AN28").Values = "bauko_3_4_6_5"
.Range("AO28").Values = "bauko_3_4_6_6"
.Range("AP28").Values = "bauko_4_1"
.Range("AQ28").Values = "bauko_4_2"
.Range("AR28").Values = "bauko_4_3"
.Range("AS28").Values = "bauko_4_4"
.Range("AT28").Values = "bauko_4_5"
.Range("AU28").Values = "bauko_4_6"
.Range("AV28").Values = "bauko_5_1"
.Range("AW28").Values = "bauko_5_2"
.Range("AX28").Values = "bauko_5_3"
.Range("AY28").Values = "bauko_6_1"
.Range("AZ28").Values = "bauko_6_2"
.Range("BA28").Values = "bauko_6_3"
.Range("B39").Values = "PD"
.Range("B40").Values = "BLN"
.Range("B41").Values = "CS"
.Range("B42").Values = "NSZ"
.Range("B43").Values = "SWE"
.Range("B44").Values = "I.NP-O-F"
.Range("B45").Values = "I.NA-O-R"
.Range("B46").Values = "Summe"
.Range("C39").Values = "bauko_3_1"
.Range("D39").Values = "bauko_3_2"
.Range("E39").Values = "bauko_3_3"
.Range("F39").Values = "bauko_3_4_1"
.Range("G39").Values = "bauko_3_4_2"
.Range("H39").Values = "bauko_3_4_3"
.Range("I39").Values = "bauko_4_1"
.Range("J39").Values = "bauko_4_2"
.Range("K39").Values = "bauko_4_3"
.Range("L39").Values = "bauko_5_1"
.Range("M39").Values = "bauko_5_2"
.Range("N39").Values = "bauko_5_3"
.Range("O39").Values = "bauko_5_4"
.Range("P39").Values = "bauko_5_5"
End With
End Sub
'###########################################################################3
'Modul5:
'** ThisWorkbook oder AktivWorkbook???
'** bitte prüfen und selbst festlegen
'** AktivWorkbook erst nach Open ExportDatei!!
Sub Blatt_Auswertung_Formeln_einrichten()
With ThisWorkbook.Sheets("Auswertung") '** This oder Activ Workbbok??
'nur Formeln und Autofill einrichten
.Range("E11").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
.Range("F5").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
.Range("F6").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
.Range("F7").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
.Range("F8").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
.Range("F9").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
.Range("F10").FormulaR1C1 = "=SUM(RC[-3]:RC[-1])"
.Range("F11").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
.Range("C5").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*BLN*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
.Range("C6").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*CS*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
.Range("C7").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*NSZ*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
.Range("C8").FormulaR1C1 = _
"=COUNTIFS('V03'!C[10],""*SWE*"",'V03'!C3,Eingabe!R5C3,'V03'!C,Eingabe!R5C4)"
.Range("C9").FormulaR1C1 = _
"=COUNTIFS('V03'!C[8],""*I.NP-O(A)*"",'V03'!C,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NP-O (A)*"",'V03'!C,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NA-O-F*"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C10").FormulaR1C1 = _
"=COUNTIFS('V03'!C[8],""*I.NP-O-R*"",'V03'!C3,Eingabe!R5C3,'V03'!C3, Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NA-O-R*"",'V03'!C3, Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C11").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
.Range("D5").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*BLN*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
.Range("D6").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*CS*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
.Range("D7").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*NSZ*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
.Range("D8").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[9],""*SWE*"",'V03 erweitert'!C[-1],Eingabe!R5C3,'V03 erweitert'!C[-1],Eingabe!R5C4)"
.Range("D9").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[7],""*I.NP-O(A)*"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C[7],""*I.NP-O (A)*"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C[7],""*I.NA-O-F*"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
.Range("D10").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C[10],""*I.NP-O-R*"",'V03 erweitert'!C3, Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)+COUNTIFS('V03 erweitert'!C[10],""*I.NA-O-R*"",'V03 erweitert'!C3, Eingabe!R5C3,'V03 erweitert'!C3, Eingabe!R5C4)"
.Range("D11").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
.Range("E5").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*BLN*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
.Range("E6").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*CS*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
.Range("E7").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*NSZ*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
.Range("E8").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[8],""*SWE*"",'V0405'!C[-2],Eingabe!R5C3,'V0405'!C[-2],Eingabe!R5C4)"
.Range("E9").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[6],""*I.NP-O(A)*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)+COUNTIFS('V0405'!C[6],""*I.NP-O (A)*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)+COUNTIFS('V0405'!C[6],""*I.NA-O-F*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
.Range("E10").FormulaR1C1 = _
"=COUNTIFS('V0405'!C[9],""*I.NP-O-R*"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3, Eingabe!R5C4)+COUNTIFS('V0405'!C[9],""*I.NA-O-R*"",'V0405'!C3, Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
.Range("C18").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*BLN*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C18").AutoFill Destination:=.Range("C18:AV18"), Type:=xlFillDefault
.Range("C19").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*CS*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C19").AutoFill Destination:=.Range("C19:AV19"), Type:=xlFillDefault
.Range("C20").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*NSZ*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C20").AutoFill Destination:=.Range("C20:AV20"), Type:=xlFillDefault
.Range("C21").FormulaR1C1 = _
"=COUNTIFS('V03'!C13,""*SWE*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C21").AutoFill Destination:=.Range("C21:AV21"), Type:=xlFillDefault
.Range("C22").FormulaR1C1 = _
"=COUNTIFS('V03'!C11,""*I.NP-O(A)*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NP-O (A)*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C11,""*I.NA-O-F*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C22").AutoFill Destination:=.Range("C22:AV22"), Type:=xlFillDefault
.Range("C23").FormulaR1C1 = _
"=COUNTIFS('V03'!C14,""*I.NP-O-R*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)+COUNTIFS('V03'!C14,""*I.NA-O-R*"",'V03'!C[24],""nein"",'V03'!C3,Eingabe!R5C3,'V03'!C3,Eingabe!R5C4)"
.Range("C23").AutoFill Destination:=.Range("C23:AV23"), Type:=xlFillDefault
.Range("C24").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
.Range("C24").AutoFill Destination:=.Range("C24:AV24"), Type:=xlFillDefault
.Range("B26:E26").FormulaR1C1 = """Nein""-Rückmeldungen V03 erw."
.Range("C29").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*BLN*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
.Range("C29").AutoFill Destination:=.Range("C29:BA29"), Type:=xlFillDefault
.Range("C30").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*CS*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
.Range("C30").AutoFill Destination:=.Range("C30:BA30"), Type:=xlFillDefault
.Range("C31").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*NSZ*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
.Range("C31").AutoFill Destination:=.Range("C31:BA31"), Type:=xlFillDefault
.Range("C32").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C13,""*SWE*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
.Range("C32").AutoFill Destination:=.Range("C32:BA32"), Type:=xlFillDefault
.Range("C33").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C11,""*I.NP-O(A)*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)" & _
"+COUNTIFS('V03 erweitert'!C11,""*I.NP-O (A)*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)" & _
"+COUNTIFS('V03 erweitert'!C11,""*I.NA-O-F*"",'V03 erweitert'!C[23],""nein"",'V03 erwe" & "itert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)" & ""
.Range("C33").AutoFill Destination:=.Range("C33:BA33"), Type:=xlFillDefault
.Range("C34").FormulaR1C1 = _
"=COUNTIFS('V03 erweitert'!C14,""*I.NP-O-R*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)" & _
"+COUNTIFS('V03 erweitert'!C14,""*I.NA-O-R*"",'V03 erweitert'!C[23],""nein"",'V03 erweitert'!C3,Eingabe!R5C3,'V03 erweitert'!C3,Eingabe!R5C4)"
.Range("C34").AutoFill Destination:=.Range("C34:BA34"), Type:=xlFillDefault
.Range("C35").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
.Range("C35").AutoFill Destination:=.Range("C35:BA35"), Type:=xlFillDefault
.Range("B37:E37").FormulaR1C1 = """Nein""-Rückmeldungen V05"
.Range("C40").FormulaR1C1 = "=COUNTIFS('V0405'!C13,""*BLN*"",'V0405'!C[21],""nein"",'V0405'!C3,Eingabe!R5C3,'V0405'!C3,Eingabe!R5C4)"
.Range("C46").FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
.Range("C40").AutoFill Destination:=.Range("C40:P40"), Type:=xlFillDefault
.Range("C41").AutoFill Destination:=.Range("C41:P41"), Type:=xlFillDefault
.Range("C42").AutoFill Destination:=.Range("C42:P42"), Type:=xlFillDefault
.Range("C43").AutoFill Destination:=.Range("C43:P43"), Type:=xlFillDefault
.Range("C44").AutoFill Destination:=.Range("C44:P44"), Type:=xlFillDefault
.Range("C45").AutoFill Destination:=.Range("C45:P45"), Type:=xlFillDefault
.Range("C46").AutoFill Destination:=.Range("C46:P46"), Type:=xlFillDefault
End With
End Sub
'###########################################################################3
'Modul6:
'** ThisWorkbook oder AktivWorkbook???
'** bitte prüfen und selbst festlegen
'** AktivWorkbook erst nach Open ExportDatei!!
Sub Blatt_Aufschlüsselung_einrichten()
'nur Text in Zellen einrichten
With ThisWorkbook.Sheets("Aufschlüsselung") '** This oder Activ Workbbok??
.Cells.ClearContents
.Range("B3:E3").Values = """Nein""-Rückmeldungen V03"
.Range("B5").Values = "PD " & ORT
.Range("C5").Values = "bauko_3_1_1"
.Range("D5").Values = "bauko_3_1_2"
.Range("E5").Values = "bauko_3_1_3"
.Range("F5").Values = "bauko_3_2_1"
.Range("G5").Values = "bauko_3_2_2"
.Range("H5").Values = "bauko_3_2_3"
.Range("I5").Values = "bauko_3_2_4"
.Range("J5").Values = "bauko_3_2_5"
.Range("K5").Values = "bauko_3_3_1"
.Range("L5").Values = "bauko_3_3_2"
.Range("M5").Values = "bauko_3_3_3"
.Range("N5").Values = "bauko_3_3_4"
.Range("O5").Values = "bauko_3_3_5"
.Range("P5").Values = "bauko_3_3_6"
.Range("Q5").Values = "bauko_3_3_7"
.Range("R5").Values = "bauko_3_3_8"
.Range("S5").Values = "bauko_3_4_1"
.Range("T5").Values = "bauko_3_4_2"
.Range("U5").Values = "bauko_3_4_2_1"
.Range("V5").Values = "bauko_3_4_3"
.Range("W5").Values = "bauko_3_4_3_1"
.Range("X5").Values = "bauko_3_4_3_2"
.Range("Y5").Values = "bauko_3_4_3_3"
.Range("Z5").Values = "bauko_3_4_4"
.Range("AA5").Values = "bauko_3_4_4_1"
.Range("AB5").Values = "bauko_3_4_4_2"
.Range("AC5").Values = "bauko_3_4_4_3"
.Range("AD5").Values = "bauko_3_4_4_4"
.Range("AE5").Values = "bauko_3_4_4_5"
.Range("AF5").Values = "bauko_3_4_5"
.Range("AG5").Values = "bauko_3_4_5_1"
.Range("AH5").Values = "bauko_3_4_5_2"
.Range("AI5").Values = "bauko_3_4_5_3"
.Range("AJ5").Values = "bauko_3_4_6_1"
.Range("AK5").Values = "bauko_3_4_6_2"
.Range("AL5").Values = "bauko_3_4_6_3"
.Range("AM5").Values = "bauko_3_4_6_4"
.Range("AN5").Values = "bauko_3_4_6_5"
.Range("AO5").Values = "bauko_3_4_6_6"
.Range("AP5").Values = "bauko_4_1"
.Range("AQ5").Values = "bauko_4_2"
.Range("AR5").Values = "bauko_4_3"
.Range("AS5").Values = "bauko_4_4"
.Range("AT5").Values = "bauko_4_5"
.Range("AU5").Values = "bauko_4_6"
.Range("AV5").Values = "bauko_5_1"
End With
End Sub
'###########################################################################3
'Modul7:
Sub Blatt_Aufschlüsselung_einrichten_M1()
With Sheets("Aufschlüsselung")
letztezeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
.Cells(letztezeile + 2, 2) = "PD " & ORT
.Cells(letztezeile + 2, 3) = "bauko_3_1_1"
.Cells(letztezeile + 2, 4) = "bauko_3_1_2"
.Cells(letztezeile + 2, 5) = "bauko_3_1_3"
.Cells(letztezeile + 2, 6) = "bauko_3_2_1"
.Cells(letztezeile + 2, 7) = "bauko_3_2_2"
.Cells(letztezeile + 2, 8) = "bauko_3_2_3"
.Cells(letztezeile + 2, 9) = "bauko_3_2_4"
.Cells(letztezeile + 2, 10) = "bauko_3_2_5"
.Cells(letztezeile + 2, 11) = "bauko_3_3_1"
.Cells(letztezeile + 2, 12) = "bauko_3_3_2"
.Cells(letztezeile + 2, 13) = "bauko_3_3_3"
.Cells(letztezeile + 2, 14) = "bauko_3_3_4"
.Cells(letztezeile + 2, 15) = "bauko_3_3_5"
.Cells(letztezeile + 2, 16) = "bauko_3_3_6"
.Cells(letztezeile + 2, 17) = "bauko_3_3_7"
.Cells(letztezeile + 2, 18) = "bauko_3_3_8"
.Cells(letztezeile + 2, 19) = "bauko_3_4_1"
.Cells(letztezeile + 2, 20) = "bauko_3_4_2"
.Cells(letztezeile + 2, 21) = "bauko_3_4_2_1"
.Cells(letztezeile + 2, 22) = "bauko_3_4_3"
.Cells(letztezeile + 2, 23) = "bauko_3_4_3_1"
.Cells(letztezeile + 2, 24) = "bauko_3_4_3_2"
.Cells(letztezeile + 2, 25) = "bauko_3_4_3_3"
.Cells(letztezeile + 2, 26) = "bauko_3_4_4"
.Cells(letztezeile + 2, 27) = "bauko_3_4_4_1"
.Cells(letztezeile + 2, 28) = "bauko_3_4_4_2"
.Cells(letztezeile + 2, 29) = "bauko_3_4_4_3"
.Cells(letztezeile + 2, 30) = "bauko_3_4_4_4"
.Cells(letztezeile + 2, 31) = "bauko_3_4_4_5"
.Cells(letztezeile + 2, 32) = "bauko_3_4_5"
.Cells(letztezeile + 2, 33) = "bauko_3_4_5_1"
.Cells(letztezeile + 2, 34) = "bauko_3_4_5_2"
.Cells(letztezeile + 2, 35) = "bauko_3_4_5_3"
.Cells(letztezeile + 2, 36) = "bauko_3_4_6_1"
.Cells(letztezeile + 2, 37) = "bauko_3_4_6_2"
.Cells(letztezeile + 2, 38) = "bauko_3_4_6_3"
.Cells(letztezeile + 2, 39) = "bauko_3_4_6_4"
.Cells(letztezeile + 2, 40) = "bauko_3_4_6_5"
.Cells(letztezeile + 2, 41) = "bauko_3_4_6_6"
.Cells(letztezeile + 2, 42) = "bauko_4_1"
.Cells(letztezeile + 2, 43) = "bauko_4_2"
.Cells(letztezeile + 2, 44) = "bauko_4_3"
.Cells(letztezeile + 2, 45) = "bauko_4_4"
.Cells(letztezeile + 2, 46) = "bauko_4_5"
.Cells(letztezeile + 2, 47) = "bauko_4_6"
.Cells(letztezeile + 2, 48) = "bauko_5_1"
.Cells(letztezeile + 2, 49) = "bauko_5_2"
.Cells(letztezeile + 2, 50) = "bauko_5_3"
.Cells(letztezeile + 2, 51) = "bauko_6_1"
.Cells(letztezeile + 2, 52) = "bauko_6_2"
.Cells(letztezeile + 2, 53) = "bauko_6_3"
End With
End Sub
Sub Blatt_Aufschlüsselung_einrichten_M2()
With Sheets("Aufschlüsselung")
letztezeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 4
.Cells(letztezeile + 2, 2) = "PD " & ORT
.Cells(letztezeile + 2, 3) = "bauko_3_1"
.Cells(letztezeile + 2, 4) = "bauko_3_2"
.Cells(letztezeile + 2, 5) = "bauko_3_3"
.Cells(letztezeile + 2, 6) = "bauko_3_4_1"
.Cells(letztezeile + 2, 7) = "bauko_3_4_2"
.Cells(letztezeile + 2, 8) = "bauko_3_4_3"
.Cells(letztezeile + 2, 9) = "bauko_4_1"
.Cells(letztezeile + 2, 10) = "bauko_4_2"
.Cells(letztezeile + 2, 11) = "bauko_4_3"
.Cells(letztezeile + 2, 12) = "bauko_5_1"
.Cells(letztezeile + 2, 13) = "bauko_5_2"
.Cells(letztezeile + 2, 14) = "bauko_5_3"
.Cells(letztezeile + 2, 15) = "bauko_5_4"
.Cells(letztezeile + 2, 16) = "bauko_5_5"
End With
End Sub
'##################### Ende ####################
|