Option Explicit
Sub DatenHolen()
Dim Ende1, Ende4, Ende5, Ende6 As Long
Dim Position As String
Dim Beenden As Boolean
' Tabellenstrukturprüfung
Call Abbruch(Beenden) 'Modul7
If Beenden = True Then Exit Sub
Ende1 = Worksheets("Wellenkaliber").Range("Laenge1").Value
Ende4 = Worksheets("Wellenkaliber").Range("Laenge4").Value
Ende5 = Worksheets("Wellenkaliber").Range("Laenge5").Value
Ende6 = Worksheets("Wellenkaliber").Range("Laenge6").Value
' Prüfung, ob Daten vorhanden sind
If Ende1 = 4 Then
MsgBox ("Diese Liste enthält keine Daten")
Exit Sub
End If
Worksheets("Auftrag").Activate
Position = ActiveCell.Address
' Autofilter aus
If Worksheets("Auftrag").AutoFilterMode = True Then
Worksheets("Auftrag").AutoFilterMode = False
Worksheets("Auftrag").Rows("4:4").AutoFilter
End If
' alte Daten löschen
Range(Cells(5, 4), Cells(Ende1 + 5, 50)).ClearContents
Application.ScreenUpdating = False
Range("B2:B3").ClearContents
Range("Z2:Z3").ClearContents
Range("X3").ClearContents
Range("AU3").ClearContents
Range("A1").Select
' Der Test hat ergeben, dass aufgrund der Datenmenge eine Berechnung der
' einzelnen Zellen über eine Schleifenstruktur im VBA-Modul erheblich
' länger dauert, als folgende Methode:
' in der ersten Zeile des zu berechnenden Datenbereichs werden die Formeln
' geschrieben. Anschließend werden diese Formeln per "Copy and Past"
' in alle zu berechnenden Zellen kopiert. Dann werden die Formeln
' durch die berechneten Werte ersetzt.
' Die Excel eigenen Methoden zum Kopieren und Inhalte einfügen laufen
' wesentlich schneller ab, als reiner VBA Code.
'Daten P912
Range("D5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";3;Falsch)"
Range("E5").FormulaLocal = "=SVERWEIS(D5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("F5").FormulaLocal = "=SVERWEIS(D5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("G5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";5;FALSCH)"
Range("H5").FormulaLocal = "=SVERWEIS(G5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("I5").FormulaLocal = "=SVERWEIS(G5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("J5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";7;FALSCH)"
Range("K5").FormulaLocal = "=SVERWEIS(J5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("L5").FormulaLocal = "=SVERWEIS(J5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("M5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";9;FALSCH)"
Range("N5").FormulaLocal = "=SVERWEIS(M5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("O5").FormulaLocal = "=SVERWEIS(M5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("P5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";11;FALSCH)"
Range("Q5").FormulaLocal = "=SVERWEIS(P5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("R5").FormulaLocal = "=SVERWEIS(P5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("S5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";16;FALSCH)"
Range("T5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";17;FALSCH)"
Range("U5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";13;FALSCH)/100"
Range("V5").FormulaLocal = "=U5*C5"
Range("W5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$S$" & Ende4 & ";19;FALSCH)"
Range("X5").FormulaLocal = "=SVERWEIS($B5;'p912'!$A$2:$Q$" & Ende4 & ";14;FALSCH)"
Range(Cells(5, 2), Cells(Ende1, 2)).Copy
Range(Cells(5, 26), Cells(Ende1, 26)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Range(Cells(5, 4), Cells(5, 24)).Copy
Range(Cells(6, 4), Cells(Ende1, 24)).PasteSpecial (xlPasteFormulas)
Application.CutCopyMode = False
Range(Cells(5, 4), Cells(Ende1, 24)).Copy
Range(Cells(5, 4), Cells(Ende1, 24)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
'Application.ScreenUpdating = True
'Range("Z5").Select
'Application.ScreenUpdating = False
'P994
Range("AA5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";3;Falsch)"
Range("AB5").FormulaLocal = "=SVERWEIS(AA5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("AC5").FormulaLocal = "=SVERWEIS(AA5;Papierpreise!$A$3:$C$203;3;FALSCH)"
Range("AD5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";5;FALSCH)"
Range("AE5").FormulaLocal = "=SVERWEIS(AD5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("AF5").FormulaLocal = "=SVERWEIS(AD5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("AG5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";7;FALSCH)"
Range("AH5").FormulaLocal = "=SVERWEIS(AG5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("AI5").FormulaLocal = "=SVERWEIS(AG5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("AJ5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";9;FALSCH)"
Range("AK5").FormulaLocal = "=SVERWEIS(AJ5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("AL5").FormulaLocal = "=SVERWEIS(AJ5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("AM5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";11;FALSCH)"
Range("AN5").FormulaLocal = "=SVERWEIS(AM5;Papierpreise!$A$3:$C$" & Ende6 & ";2;FALSCH)"
Range("AO5").FormulaLocal = "=SVERWEIS(AM5;Papierpreise!$A$3:$C$" & Ende6 & ";3;FALSCH)"
Range("AP5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";16;FALSCH)"
Range("AQ5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";17;FALSCH)"
Range("AR5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";13;FALSCH)/100"
Range("AS5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$S$" & Ende5 & ";19;FALSCH)"
Range("AT5").FormulaLocal = "=(AS5-W5)/W5"
Range("AU5").FormulaLocal = "=SVERWEIS($Z5;'p994'!$A$2:$Q$" & Ende5 & ";14;FALSCH)"
Range("AV5").FormulaLocal = "=(AR5-U5)*C5"
Range(Cells(5, 27), Cells(5, 48)).Copy
Range(Cells(6, 27), Cells(Ende1, 48)).PasteSpecial (xlPasteFormulas)
Application.CutCopyMode = False
' dieser Block ist auskommentiert, da der Anwender die Formeln
' in diesem Tabellenbereich behalten wollte, um schnell Ergebnisse
' nach manuellen Änderungen der Daten zu bekommen, ohne die komplette
' Prozedur starten zu müssen:
'Range(Cells(5, 27), Cells(Ende1, 48)).Copy
'Range(Cells(5, 27), Cells(Ende1, 48)).PasteSpecial (xlPasteValues)
'Application.CutCopyMode = False
'Range("Z5").Select
Range("AW5").FormulaLocal = "=SVERWEIS(S5;Wellenkaliber!$A$2:$B$6;2;FALSCH)"
Range("AX5").FormulaLocal = "=SVERWEIS(T5;Wellenkaliber!$A$2:$B$6;2;FALSCH)"
Range(Cells(5, 49), Cells(5, 50)).Copy
Range(Cells(6, 49), Cells(Ende1, 50)).PasteSpecial (xlPasteFormulas)
Application.CutCopyMode = False
Range(Cells(5, 49), Cells(Ende1, 50)).Copy
Range(Cells(5, 49), Cells(Ende1, 50)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
'Range("A3").Select
'Range("X3").FormulaLocal = "=SUMMENPRODUKT(X5:X" & Ende1 & "*C5:C" & Ende1 & ")/1000000"
Range("X3").FormulaLocal = "=SUMMENPRODUKT(TEILERGEBNIS(6;INDIREKT(""X""&ZEILE(5:" & Ende1 & ")));C5:C" & Ende1 & ")/1000000"
'Range("AU3").FormulaLocal = "=SUMMENPRODUKT(AU5:AU" & Ende1 & "*C5:C" & Ende1 & ")/1000000"
Range("AU3").FormulaLocal = "=SUMMENPRODUKT(TEILERGEBNIS(6;INDIREKT(""AU""&ZEILE(5:" & Ende1 & ")));C5:C" & Ende1 & ")/1000000"
' Besonderheit: man achte auf die RC Addressierung der Bezüge in den Arrayformeln
Range("B2").FormulaArray = _
"=COUNT(1/FREQUENCY(IF((SUBTOTAL(3,OFFSET(R5C,ROW(R5C:R" & Ende1 & "C)-ROW(R5C),0))=1)*(R5C:R" & Ende1 & "C<>""""),MATCH(R5C:R" & Ende1 & "C,R5C:R" & Ende1
& "C,0)),ROW(INDIRECT(""1:""&COUNTA(R5C:R" & Ende1 & "C)))))"
Range("Z2").FormulaArray = _
"=COUNT(1/FREQUENCY(IF((SUBTOTAL(3,OFFSET(R5C,ROW(R5C:R" & Ende1 & "C)-ROW(R5C),0))=1)*(R5C:R" & Ende1 & "C<>""""),MATCH(R5C:R" & Ende1 & "C,R5C:R" & Ende1
& "C,0)),ROW(INDIRECT(""1:""&COUNTA(R5C:R" & Ende1 & "C)))))"
Range("B3").FormulaArray = _
"=SUM(IF(R5C:R" & Ende1 & "C<>"""",1/COUNTIF(R5C:R" & Ende1 & "C,R5C:R" & Ende1 & "C)))"
Range("Z3").FormulaArray = _
"=SUM(IF(R5C:R" & Ende1 & "C<>"""",1/COUNTIF(R5C:R" & Ende1 & "C,R5C:R" & Ende1 & "C)))"
Range("C3").FormulaLocal = "=TEILERGEBNIS(9;C5:C" & Ende1 & ")"
Range("V3").FormulaLocal = "=TEILERGEBNIS(9;V5:V" & Ende1 & ")"
Range("W3").FormulaLocal = "=(SUMMENPRODUKT(TEILERGEBNIS(6;INDIREKT(""W""&ZEILE(5:" & Ende1 & ")));C5:C" & Ende1 & ")/C3)"
Range("AS3").FormulaLocal = "=(SUMMENPRODUKT(TEILERGEBNIS(6;INDIREKT(""AS""&ZEILE(5:" & Ende1 & ")));C5:C" & Ende1 & ")/C3)"
Range("AV3").FormulaLocal = "=TEILERGEBNIS(9;AV5:AV" & Ende1 & ")"
Range(Position).Activate
Application.ScreenUpdating = True
MsgBox ("Daten komplett übertragen")
End Sub
Option Explicit
Sub Analyse()
Dim SortenNr(1001), Beenden As Boolean
Dim I As Long
Dim X As Integer
Dim Ende1, Ende2, Ende3, Ende4, Ende5, Ende6 As Long
Dim A, B, C, D, E, F, SFqm, SFTonnen, Position As String
Dim Diff As Integer
Dim Summe(8) As String
Call Abbruch(Beenden)
If Beenden = True Then Exit Sub
Ende1 = Worksheets("Wellenkaliber").Range("Laenge1").Value
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
Ende4 = Worksheets("Wellenkaliber").Range("Laenge4").Value
Ende5 = Worksheets("Wellenkaliber").Range("Laenge5").Value
Ende6 = Worksheets("Wellenkaliber").Range("Laenge6").Value
If Ende1 = 4 Then
MsgBox ("Diese Liste enthält keine Daten")
Exit Sub
End If
Application.ScreenUpdating = False
If Worksheets("Papiereinsatz").AutoFilterMode = True Then
Worksheets("Papiereinsatz").AutoFilterMode = False
Worksheets("Papiereinsatz").Rows("9:9").AutoFilter
With Worksheets("Papiereinsatz").CommandButton1
.Caption = "P994 Filter"
End With
End If
Worksheets("Auftrag").Activate
Position = ActiveCell.Address
For I = 5 To Ende1
SortenNr(Cells(I, 4).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 7).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 10).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 13).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 16).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 27).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 30).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 33).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 36).Value) = True
Next I
For I = 5 To Ende1
SortenNr(Cells(I, 39).Value) = True
Next I
Worksheets("Papiereinsatz").Activate
'Application.ScreenUpdating = True
Range("Sortenanzahl").ClearContents
Range("H4:K4").ClearContents
Range("D4:G4").ClearContents
Range("I3").ClearContents
Range("D7:K7").ClearContents
Range(Cells(10, 1), Cells(Ende2 + 10, 11)).ClearContents
X = 10
For I = 1 To 1001
If SortenNr(I) = True Then
Worksheets("Papiereinsatz").Cells(X, 1).Value = I
X = X + 1
End If
Next
X = X - 1
'For I = 10 To X
'Worksheets("Papiereinsatz").Cells(I, 2).Value = _
'Application.WorksheetFunction. _
'VLookup(Cells(I, 1).Value, Worksheets("Papierpreise"). _
'Range("A4:D93"), 2, False)
'
'Worksheets("Papiereinsatz").Cells(I, 3).Value = _
'Application.WorksheetFunction. _
'VLookup(Cells(I, 1).Value, Worksheets("Papierpreise"). _
'Range("A4:D93"), 3, False)
'
'Next I
Worksheets("Papiereinsatz"). _
Range("B10").FormulaLocal = "=SVERWEIS($A10;'Papierpreise'!$A$4:$D$" & Ende6 & ";2;Falsch)"
Worksheets("Papiereinsatz").Range("B10").Select
'Selection.AutoFill 'Destination:=Range("B2:B45") 'Destination:=Range(Cells(10, 2), Cells(2, X))
Selection.AutoFill Destination:=Range(Cells(10, 2), Cells(X, 2))
Worksheets("Papiereinsatz"). _
Range("C10").FormulaLocal = "=SVERWEIS($A10;'Papierpreise'!$A$4:$D$" & Ende6 & ";3;Falsch)"
Worksheets("Papiereinsatz").Range("C10").Select
Selection.AutoFill Destination:=Range(Cells(10, 3), Cells(X, 3))
Range(Cells(10, 2), Cells(X, 3)).Copy
Range(Cells(10, 2), Cells(X, 3)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Range("E9").Select
'------------------------------------------------------
'Analyse Teil 2
'P912
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
Ende3 = Worksheets("Wellenkaliber").Range("Laenge3").Value
'Application.ScreenUpdating = False
A = "=(SUMMENPRODUKT((Auftrag!$D$5:$D$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
B = "+SUMMENPRODUKT((Auftrag!$J$5:$J$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
C = "+SUMMENPRODUKT((Auftrag!$P$5:$P$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "))"
D = "+SUMMENPRODUKT((Auftrag!$G$5:$G$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AW$5:$AW$" & Ende3 & ")"
E = "+SUMMENPRODUKT((Auftrag!$M$5:$M$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AX$5:$AX$" & Ende3 & ")"
'A = "=(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""D""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
'B = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""J""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
'C = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""P""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
'D = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""G""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")*(Auftrag!$AW$5:$AW$" & Ende3
& ")))"
'E = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""M""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")*(Auftrag!$AX$5:$AX$" & Ende3
& ")))"
SFqm = A & B & C & D & E
Range("D10").FormulaLocal = SFqm
Range("E10").FormulaLocal = "=D10/$D$9*$E$9"
Range("F10").FormulaLocal = "=D10*C10/1000000"
Range("G10").FormulaLocal = "=F10/$D$9*$E$9"
Range("E9").Select
Worksheets("Papiereinsatz").Range("D10:G10").Select
Selection.AutoFill Destination:=Range(Cells(10, 4), Cells(Ende2, 7))
Worksheets("Papiereinsatz").Range(Cells(10, 4), Cells(Ende2, 4)).Copy
Range(Cells(10, 4), Cells(Ende2, 4)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Worksheets("Papiereinsatz").Range(Cells(10, 6), Cells(Ende2, 6)).Copy
Range(Cells(10, 6), Cells(Ende2, 6)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Range("D4").Select
A = "=""P912 = ""&ZÄHLENWENN(D10:D" & Ende2 & ";"">0"")&"" Sorten"""
Range("D4").FormulaLocal = A
'----------------------------------------------------------
'P994
A = "=(SUMMENPRODUKT((Auftrag!$AA$5:$AA$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
B = "+SUMMENPRODUKT((Auftrag!$AG$5:$AG$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
C = "+SUMMENPRODUKT((Auftrag!$AM$5:$AM$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "))"
D = "+SUMMENPRODUKT((Auftrag!$AD$5:$AD$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AW$5:$AW$" & Ende3 & ")"
E = "+SUMMENPRODUKT((Auftrag!$AJ$5:$AJ$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AX$5:$AX$" & Ende3 & ")"
SFqm = A & B & C & D & E
Range("H10").FormulaLocal = SFqm
Range("I10").FormulaLocal = "=H10/$D$9*$E$9"
Range("J10").FormulaLocal = "=H10*C10/1000000"
Range("K10").FormulaLocal = "=J10/$D$9*$E$9"
Worksheets("Papiereinsatz").Range("H10:K10").Select
Selection.AutoFill Destination:=Range(Cells(10, 8), Cells(Ende2, 11))
Worksheets("Papiereinsatz").Range(Cells(10, 8), Cells(Ende2, 8)).Copy
Range(Cells(10, 8), Cells(Ende2, 8)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Worksheets("Papiereinsatz").Range(Cells(10, 10), Cells(Ende2, 10)).Copy
Range(Cells(10, 10), Cells(Ende2, 10)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
A = "=""P994 = ""&ZÄHLENWENN(H10:H" & Ende2 & ";"">0"")&"" Sorten""&"" Diff = ""&TEXT(Auftrag!AV3; ""#.##0 €"")"
Range("H4").FormulaLocal = A
Range("I3").Value = "Sortierung:" & Chr(10) & "Sorten"
Summe(0) = "=SUMME(D10:D" & Ende2 & ")"
Summe(1) = "=SUMME(E10:E" & Ende2 & ")"
Summe(2) = "=SUMME(F10:F" & Ende2 & ")"
Summe(3) = "=SUMME(G10:G" & Ende2 & ")"
Summe(4) = "=SUMME(H10:H" & Ende2 & ")"
Summe(5) = "=SUMME(I10:I" & Ende2 & ")"
Summe(6) = "=SUMME(J10:J" & Ende2 & ")"
Summe(7) = "=SUMME(K10:K" & Ende2 & ")"
Range("D7").FormulaLocal = Summe(0)
Range("E7").FormulaLocal = Summe(1)
Range("F7").FormulaLocal = Summe(2)
Range("G7").FormulaLocal = Summe(3)
Range("H7").FormulaLocal = Summe(4)
Range("I7").FormulaLocal = Summe(5)
Range("J7").FormulaLocal = Summe(6)
Range("K7").FormulaLocal = Summe(7)
Summe(8) = "=Anzahl2(A10:A" & Ende2 & ")"
Range("Sortenanzahl").FormulaLocal = Summe(8)
Range("E9").Select
Range(Position).Activate
Application.ScreenUpdating = True
MsgBox ("Berechnung ist fertig")
End Sub
Option Explicit
Sub alles_löschen()
Dim Ende1, Ende2 As Long
Dim Bereich1, Bereich2 As String
Dim Beenden As Boolean
'Application.ScreenUpdating = False
Call Abbruch(Beenden)
If Beenden = True Then Exit Sub
If Worksheets("Papiereinsatz").AutoFilterMode = True Then
Worksheets("Papiereinsatz").AutoFilterMode = False
Worksheets("Papiereinsatz").Rows("9:9").AutoFilter
With Worksheets("Papiereinsatz").CommandButton1
.Caption = "P994 Filter"
End With
End If
If Worksheets("Auftrag").AutoFilterMode = True Then
Worksheets("Auftrag").AutoFilterMode = False
Worksheets("Auftrag").Rows("4:4").AutoFilter
End If
Ende1 = Worksheets("Wellenkaliber").Range("Laenge1").Value
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
If Ende1 < 5 Then
Ende1 = 5
End If
If Ende2 < 10 Then
Ende2 = 10
End If
Bereich1 = Range(Cells(5, 4), Cells(Ende1, 50)).Address
Bereich2 = Range(Cells(10, 1), Cells(Ende2, 11)).Address
Worksheets("Auftrag").Range(Bereich1).ClearContents
Worksheets("Papiereinsatz").Range(Bereich2).ClearContents
'Application.ScreenUpdating = True
End Sub
Option Explicit
Sub FilterAnalyse()
Dim SortenNr(1001), Beenden As Boolean
Dim I As Long
Dim X As Integer
Dim Ende1, Ende2, Ende3, Ende6 As Long
Dim A, B, C, D, E, F, SFqm, SFTonnen, Position As String
Dim Diff As Integer
Dim Summe(8) As String
Call Abbruch(Beenden)
If Beenden = True Then Exit Sub
Ende1 = Worksheets("Wellenkaliber").Range("Laenge1").Value
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
Ende6 = Worksheets("Wellenkaliber").Range("Laenge6").Value
If Ende1 = 4 Then
MsgBox ("Diese Liste enthält keine Daten")
Exit Sub
End If
'If Application.ActiveSheet.Index <> 1 Then
'MsgBox ("Bitte zuerst das Blatt" & Chr(13) _
'& """Auftrag""" & Chr(13) _
'& "aktivieren")
'Exit Sub
'End If
Application.ScreenUpdating = False
If Worksheets("Papiereinsatz").AutoFilterMode = True Then
Worksheets("Papiereinsatz").AutoFilterMode = False
Worksheets("Papiereinsatz").Rows("9:9").AutoFilter
With Worksheets("Papiereinsatz").CommandButton1
.Caption = "P994 Filter"
End With
End If
Worksheets("Auftrag").Activate
'Call Modul3.LetzteZeile(Ende)
Position = ActiveCell.Address
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 4).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 7).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 10).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 13).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 16).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 27).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 30).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 33).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 36).Value) = True
End If
Next I
For I = 5 To Ende1
If Rows(I).Hidden = False Then
SortenNr(Cells(I, 39).Value) = True
End If
Next I
Worksheets("Papiereinsatz").Activate
'Application.ScreenUpdating = True
Range("Sortenanzahl").ClearContents
Range("H4:K4").ClearContents
Range("D4:G4").ClearContents
Range("I3").ClearContents
Range("D7:K7").ClearContents
Range(Cells(10, 1), Cells(Ende2 + 10, 11)).ClearContents
X = 10
For I = 1 To 1001
If SortenNr(I) = True Then
Worksheets("Papiereinsatz").Cells(X, 1).Value = I
X = X + 1
End If
Next
X = X - 1
'For I = 10 To X
'Worksheets("Papiereinsatz").Cells(I, 2).Value = _
'Application.WorksheetFunction. _
'VLookup(Cells(I, 1).Value, Worksheets("Papierpreise"). _
'Range("A4:D93"), 2, False)
'
'Worksheets("Papiereinsatz").Cells(I, 3).Value = _
'Application.WorksheetFunction. _
'VLookup(Cells(I, 1).Value, Worksheets("Papierpreise"). _
'Range("A4:D93"), 3, False)
'
'Next I
Worksheets("Papiereinsatz"). _
Range("B10").FormulaLocal = "=SVERWEIS($A10;'Papierpreise'!$A$4:$D$" & Ende6 & ";2;Falsch)"
Worksheets("Papiereinsatz").Range("B10").Select
'Selection.AutoFill 'Destination:=Range("B2:B45") 'Destination:=Range(Cells(10, 2), Cells(2, X))
Selection.AutoFill Destination:=Range(Cells(10, 2), Cells(X, 2))
Worksheets("Papiereinsatz"). _
Range("C10").FormulaLocal = "=SVERWEIS($A10;'Papierpreise'!$A$4:$D$" & Ende6 & ";3;Falsch)"
Worksheets("Papiereinsatz").Range("C10").Select
Selection.AutoFill Destination:=Range(Cells(10, 3), Cells(X, 3))
Range(Cells(10, 2), Cells(X, 3)).Copy
Range(Cells(10, 2), Cells(X, 3)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Range("E9").Select
'------------------------------------------------------
'Analyse Teil 2
'P912
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
Ende3 = Worksheets("Wellenkaliber").Range("Laenge3").Value
'Application.ScreenUpdating = False
'A = "=(SUMMENPRODUKT((Auftrag!$D$5:$D$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
'B = "+SUMMENPRODUKT((Auftrag!$J$5:$J$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
'C = "+SUMMENPRODUKT((Auftrag!$P$5:$P$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "))"
'D = "+SUMMENPRODUKT((Auftrag!$G$5:$G$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AW$5:$AW$" & Ende3 & ")"
'E = "+SUMMENPRODUKT((Auftrag!$M$5:$M$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AX$5:$AX$" & Ende3 & ")"
A = "=(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""D""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
B = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""J""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
C = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""P""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
D = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""G""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")*(Auftrag!$AW$5:$AW$" & Ende3 &
")))"
E = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""M""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")*(Auftrag!$AX$5:$AX$" & Ende3 &
")))"
SFqm = A & B & C & D & E
Range("D10").FormulaLocal = SFqm
Range("E10").FormulaLocal = "=D10/$D$9*$E$9"
Range("F10").FormulaLocal = "=D10*C10/1000000"
Range("G10").FormulaLocal = "=F10/$D$9*$E$9"
Range("E9").Select
Worksheets("Papiereinsatz").Range("D10:G10").Select
Selection.AutoFill Destination:=Range(Cells(10, 4), Cells(Ende2, 7))
Worksheets("Papiereinsatz").Range(Cells(10, 4), Cells(Ende2, 4)).Copy
Range(Cells(10, 4), Cells(Ende2, 4)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Worksheets("Papiereinsatz").Range(Cells(10, 6), Cells(Ende2, 6)).Copy
Range(Cells(10, 6), Cells(Ende2, 6)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Range("D4").Select
A = "=""P912 = ""&ZÄHLENWENN(D10:D" & Ende2 & ";"">0"")&"" Sorten"""
Range("D4").FormulaLocal = A
'----------------------------------------------------------
'P994
'A = "=(SUMMENPRODUKT((Auftrag!$AA$5:$AA$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
'B = "+SUMMENPRODUKT((Auftrag!$AG$5:$AG$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & ")"
'C = "+SUMMENPRODUKT((Auftrag!$AM$5:$AM$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "))"
'D = "+SUMMENPRODUKT((Auftrag!$AD$5:$AD$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AW$5:$AW$" & Ende3 & ")"
'E = "+SUMMENPRODUKT((Auftrag!$AJ$5:$AJ$" & Ende3 & "=$A10)*Auftrag!$C$5:$C$" & Ende3 & "*Auftrag!$AX$5:$AX$" & Ende3 & ")"
A = "=(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""AA""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
B = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""AG""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
C = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""AM""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")))"
D = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""AD""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")*(Auftrag!$AW$5:$AW$" & Ende3
& ")))"
E = "+(SUMMENPRODUKT((TEILERGEBNIS(6;INDIREKT(""Auftrag!""&""AJ""&ZEILE($5:$" & Ende3 & ")))=$A10)*(Auftrag!$C$5:$C$" & Ende3 & ")*(Auftrag!$AX$5:$AX$" & Ende3
& ")))"
SFqm = A & B & C & D & E
Range("H10").FormulaLocal = SFqm
Range("I10").FormulaLocal = "=H10/$D$9*$E$9"
Range("J10").FormulaLocal = "=H10*C10/1000000"
Range("K10").FormulaLocal = "=J10/$D$9*$E$9"
Worksheets("Papiereinsatz").Range("H10:K10").Select
Selection.AutoFill Destination:=Range(Cells(10, 8), Cells(Ende2, 11))
Worksheets("Papiereinsatz").Range(Cells(10, 8), Cells(Ende2, 8)).Copy
Range(Cells(10, 8), Cells(Ende2, 8)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Worksheets("Papiereinsatz").Range(Cells(10, 10), Cells(Ende2, 10)).Copy
Range(Cells(10, 10), Cells(Ende2, 10)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
A = "=""P994 = ""&ZÄHLENWENN(H10:H" & Ende2 & ";"">0"")&"" Sorten""&"" Diff = ""&TEXT(Auftrag!AV3; ""#.##0 €"")"
Range("H4").FormulaLocal = A
Range("I3").Value = "Sortierung:" & Chr(10) & "Sorten"
Summe(0) = "=SUMME(D10:D" & Ende2 & ")"
Summe(1) = "=SUMME(E10:E" & Ende2 & ")"
Summe(2) = "=SUMME(F10:F" & Ende2 & ")"
Summe(3) = "=SUMME(G10:G" & Ende2 & ")"
Summe(4) = "=SUMME(H10:H" & Ende2 & ")"
Summe(5) = "=SUMME(I10:I" & Ende2 & ")"
Summe(6) = "=SUMME(J10:J" & Ende2 & ")"
Summe(7) = "=SUMME(K10:K" & Ende2 & ")"
Range("D7").FormulaLocal = Summe(0)
Range("E7").FormulaLocal = Summe(1)
Range("F7").FormulaLocal = Summe(2)
Range("G7").FormulaLocal = Summe(3)
Range("H7").FormulaLocal = Summe(4)
Range("I7").FormulaLocal = Summe(5)
Range("J7").FormulaLocal = Summe(6)
Range("K7").FormulaLocal = Summe(7)
Summe(8) = "=Anzahl2(A10:A" & Ende2 & ")"
Range("Sortenanzahl").FormulaLocal = Summe(8)
Range("E9").Select
Range(Position).Activate
Application.ScreenUpdating = True
MsgBox ("Berechnung ist fertig")
End Sub
Sub Nullmenge()
' Autofilter ein und Beschriftung des CommandButton ändern
Dim Beenden As Boolean
Call Abbruch(Beenden) 'Modul7
If Beenden = True Then Exit Sub
Worksheets("Papiereinsatz").Activate
Application.ScreenUpdating = False
If Worksheets("Papiereinsatz").AutoFilterMode = True Then
Rows("9:9").AutoFilter Field:=8, Criteria1:="<>0", Operator:=xlAnd
End If
If Not Worksheets("Papiereinsatz").AutoFilterMode = True Then
Rows("9:9").AutoFilter
Rows("9:9").AutoFilter Field:=8, Criteria1:="<>0", Operator:=xlAnd
End If
With Worksheets("Papiereinsatz").CommandButton1
.Caption = "P994 Filter aus"
End With
Application.ScreenUpdating = True
End Sub
Sub NullAus()
' Autofilter aus und Beschriftung des CommandButton ändern
Dim Beenden As Boolean
Call Abbruch(Beenden) 'Modul7
If Beenden = True Then Exit Sub
Worksheets("Papiereinsatz").Activate
Application.ScreenUpdating = False
On Error Resume Next
Selection.AutoFilter Field:=8
With Worksheets("Papiereinsatz").CommandButton1
.Caption = "P994 Filter"
End With
Application.ScreenUpdating = True
End Sub
Sub Gewicht_sortieren()
Dim Ende2 As Long
Dim Bereich As String
Dim Beenden As Boolean
Call Abbruch(Beenden) 'Modul7
If Beenden = True Then Exit Sub
Worksheets("Papiereinsatz").Activate
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
Bereich = "10:" & Ende2
Rows(Bereich).Sort Key1:=Range("J10"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("I3").Value = "Sortierung:" & Chr(10) & "Gewicht"
End Sub
Sub Sorten_sortieren()
Dim Ende2 As Long
Dim Bereich As String
Dim Beenden As Boolean
Call Abbruch(Beenden) 'Modul7
If Beenden = True Then Exit Sub
Worksheets("Papiereinsatz").Activate
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
Bereich = "10:" & Ende2
Rows(Bereich).Sort Key1:=Range("A10"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("I3").Value = "Sortierung:" & Chr(10) & "Sorten"
End Sub
Sub qm_sortieren()
Dim Ende2 As Long
Dim Bereich As String
Dim Beenden As Boolean
Call Abbruch(Beenden) 'Modul7
If Beenden = True Then Exit Sub
Worksheets("Papiereinsatz").Activate
Ende2 = Worksheets("Wellenkaliber").Range("Laenge2").Value
Bereich = "10:" & Ende2
Rows(Bereich).Sort Key1:=Range("H10"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("I3").Value = "Sortierung:" & Chr(10) & "qm"
End Sub
Option Explicit
Option Explicit
Sub Abbruch(Beenden As Boolean)
' Prüfung, ob die Tabellenstruktur verändert wurde
' und Übergabe von "WAHR" oder "FALSCH" an
' die aufrufende Prozedur
Dim Pruefung1, Pruefung2 As String
Dim Antwort
Pruefung1 = Left(Worksheets("Papiereinsatz").Range("K9").Formula, 10)
Pruefung2 = Worksheets("Auftrag").Range("AX4").Value
If Pruefung1 <> "=E9/1" Or Pruefung2 <> "WE2" Then
Beenden = True
Antwort = MsgBox( _
"Die Tabellenstruktur auf dem Worksheet ""Auftrag""" & Chr(13) _
& "oder ""Papiereinsatz"" wurde verändert. Darum können" & Chr(13) _
& "die Dateiinternen Programme nicht mehr richtig arbeiten" & Chr(13) _
& "und werden deshalb deaktiviert." & Chr(13) & Chr(13) _
& "Lösung:" & Chr(13) _
& "Entweder die alte Struktur wieder herstellen oder" & Chr(13) _
& "die Programme überarbeiten." & Chr(13) _
& "(HS)", 16, "Prüfung der Tabellenstruktur")
Else
Beenden = False
End If
End Sub
Option Explicit
Option Explicit
Private Sub CommandButton1_Click()
' Autofilter aktivieren / deaktivieren in Abhängigkeit
' der momentanen Beschriftung des CommandButtons auf Tabelle(2)
With CommandButton1
If .Caption = "P994 Filter" Then
Nullmenge 'in Modul6
Else
NullAus 'in Modul6
End If
End With
End Sub
Private Sub Worksheet_Activate()
' Benutzermenüpunkt aktivieren
Dim cbSpecialMenu As CommandBarPopup
Dim UMenu As CommandBarPopup
On Error Resume Next
Set cbSpecialMenu = _
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Papiermenü")
Set UMenu = _
cbSpecialMenu.Controls("Papiereinsatz")
UMenu.Enabled = True
End Sub
Private Sub Worksheet_Deactivate()
' Benutzermenüpunkt deaktivieren
Dim cbSpecialMenu As CommandBarPopup
Dim UMenu As CommandBarPopup
On Error Resume Next
Set cbSpecialMenu = _
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Papiermenü")
Set UMenu = _
cbSpecialMenu.Controls("Papiereinsatz")
UMenu.Enabled = False
End Sub
Private Sub Workbook_Open()
Dim cbMenu As CommandBar
Dim cbSpecialMenu As CommandBarPopup
Dim cbCommand As CommandBarControl
Dim UMenu As CommandBarPopup
Dim UcbCommand As CommandBarControl
On Error Resume Next
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Papiermenü").Delete
Set cbSpecialMenu = _
Application.CommandBars("Worksheet Menu Bar") _
.Controls.Add(Type:=msoControlPopup)
cbSpecialMenu.Caption = "&Papiermenü"
Set cbCommand = _
cbSpecialMenu.Controls.Add(Type:=msoControlButton)
cbCommand.Caption = "&Daten holen"
cbCommand.OnAction = "DatenHolen"
Set cbCommand = _
cbSpecialMenu.Controls.Add(Type:=msoControlButton)
cbCommand.Caption = "&Analyse"
cbCommand.OnAction = "Analyse"
Set cbCommand = _
cbSpecialMenu.Controls.Add(Type:=msoControlButton)
cbCommand.Caption = "&Filter-Analyse"
cbCommand.OnAction = "FilterAnalyse"
cbCommand.TooltipText = "Achtung: dauert wegen umfangreicher Berechnungen länger"
cbCommand.BeginGroup = True
Set cbCommand = _
cbSpecialMenu.Controls.Add(Type:=msoControlButton)
cbCommand.Caption = "&Löschen"
cbCommand.OnAction = "alles_löschen"
cbCommand.BeginGroup = True
Set UMenu = _
cbSpecialMenu.Controls.Add(Type:=msoControlPopup)
UMenu.Caption = "&Papiereinsatz"
UMenu.BeginGroup = True
If ActiveSheet.Name <> "Papiereinsatz" Then
UMenu.Enabled = False
End If
Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&Nullmengen ausfiltern"
UcbCommand.OnAction = "Nullmenge"
'UcbCommand.BeginGroup = True
Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "Nullmengen &Filter aus"
UcbCommand.OnAction = "NullAus"
Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&Gewicht sortieren"
UcbCommand.OnAction = "Gewicht_sortieren"
UcbCommand.BeginGroup = True
Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&qm sortieren"
UcbCommand.OnAction = "qm_sortieren"
Set UcbCommand = _
UMenu.Controls.Add(Type:=msoControlButton)
UcbCommand.Caption = "&Sorten sortieren"
UcbCommand.OnAction = "Sorten_sortieren"
Application.Caption = "Excel-Tuning by HS"
' Windows(1).Caption = ActiveWorkbook.Name
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim cbSpecialMenu As CommandBarControl
On Error Resume Next
Set cbSpecialMenu = _
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Papiermenü")
cbSpecialMenu.Delete
Application.Caption = ""
' Windows(1).Caption = ActiveWorkbook.Name
End Sub
Private Sub Workbook_Deactivate()
On Error Resume Next
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Papiermenü").Visible = False
Application.Caption = ""
' Windows(1).Caption = ActiveWorkbook.Name
End Sub
Private Sub Workbook_Activate()
On Error Resume Next
Application.CommandBars("Worksheet Menu " & _
"Bar").Controls("Papiermenü").Visible = True
Application.Caption = "Excel-Tuning by HS"
' Windows(1).Caption = ActiveWorkbook.Name
End Sub
'Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' If Application.ActiveSheet.Name <> "Tabelle1" Then
' Exit Sub
' End If
'
' Range("E3").Select
' A = Application.WorksheetFunction.CountA(Range("A:A"))
' If A <= 2 Then
' Range("A3").Select
' Exit Sub
' End If
' Range(Cells(3, 5), Cells(A, 5)).Select
' Selection.FillDown
' Range("A3").Select
'