Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1448to1452
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ladebalken ProgressBar

Ladebalken ProgressBar
26.09.2015 16:29:57
Noureddine
Hallo,
ich habe ein Makro das einige Minuten benötigt. Um den Anwender zu Informieren dass, das Porgramm nicht abgestürtzt ist, will ich wärend der Laufzeit eine ProgressBar einbauen. Im Internet habe ich einige Vorschläge gefunden, jedoch möchte ich dies verstehen. Könnte mir hier jemand dies Erklären? Ich wäre sehr dankbar dafür.
Sollte nichts ansprucvolles sein. Ein Balken mit der entsprechenden Prozentangabe.
Vielen Dank vorab.

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ladebalken ProgressBar
26.09.2015 16:42:33
Peter
Hallo Noureddine,
mit der Status Bar kannst du ohne großen Aufwand deine Anwender vom Leben deiner Mappe unterrichten.
Application.StatusBar = "deine Text und deine Prozentzahl"
am Ende des Makros Application.StatusBar = False nicht vergessen.
Gruß Peter

AW: Ladebalken ProgressBar
26.09.2015 16:46:30
Noureddine
Danke für die schnelle Antwort.
Dies habe ich bereits aktuell in der Anwendung. Find ich aber nicht als die ideale Lösung, da Sie nur unten links klein angezeigt wird.
Deswegen hier mein Beitrag, ich möchte gern ein Schritt weiter gehen...
Im Makro selbst sind mehrer Schleifen vorhanden, aber das Makro an sich wird nur einmal durchgeführt.

Anzeige
AW: Ladebalken ProgressBar
26.09.2015 17:03:11
Daniel
Hi
du kannst einen Progressbar nur dann selbstständig anzeigen lassen, wenn du eine Schleife hast oder ein laufendes Makro, dh wenn du durch einen Programmschritt die Progressbar aktualisieren kannst:
For i = 1 to 100
Progressbar = Progressbar + 1
hier dein Code
Next
oder
Programmteil 1
Progressbar = Progressbar + 1
Programmteil 2
Progressbar = Progressbar + 1
Programmteil 3
Progressbar = Progressbar + 1
du kannst keine eigene Progressbar anzeigen lassen, wenn ein einzelnen Befehl einen längerdauernden Prozess auslöst (z.B. öffnen einer grösseren Datei, aktualisieren von Datenbankabfragen ggf aus dem Internet, Neuberechnen von Zellen)
in diesen Fällen bist du auf die von Excel automatisch in der Statusleiste angezeigten Fortschrittsbalken angewiesen.
sollte der Fall 1 zurtreffen, dann hast du zwei möglichkeiten:
a) die Statusleiste
du kannst in der Statusleise eigene Texte anzeigen lassen, um so den Fortschritt zu dokumntieren.
hier kannst du nur Text anzeigen lassen ("Bearbeitet: 53%", "Schritt 1 von 10"), aber keine Grafik, dh Balken müsstest du durch wiederholen von Textzeichen darstellen.
Dim i As Long
For i = 1 To 100
Application.StatusBar = "Bearbeitet: " & Format(i / 100, "0%") & _
" " & String(10 * i / 100, "X")
Application.Wait Now + TimeSerial(0, 0, 1)
Next
Application.StatusBar = False
b1) Userform mit Steuerelement "Progressbar"
du kannst eine userform erstellen und auf dieser das Steuerelement "Progressbar" einfügen (findet sich in der Werkzeugleiste der Userform, ggf musst du über das Kontextmenü der Werkzeugleiste das Steuerelement in den weitern Steuerelementen suchen, um es verfügbar zu machen)
dieser Progressbar weist du dann einfach je nach Fortschritt einen Wert von 0-100 zu und bekommst den jeweiligen Balken (Progressbar.Value = 43)
b2) Userform mit Label
erstelle eine Userform mit einen Label.
gib den Label eine Farbe.
Verändere bei Programmfortschritt die breite des labels (Label1.Width = 123)
bei den Userformmethoden musst du beachten, wie Userform und dein Code zusammenspielen.
Wenn der Arbeitscode nicht bestandteil der Userform ist, muss diese auf jeden Fall die Eigenschaft "ShowModal = False" sein, damit der Makrocode laufen kann, wärend die Userform geöffnet ist.
ggf kann es sein, dass VBA lieber den Code weiter ausführt, als sich um die Bildschirmdarstellung zu kümmern. In diesem Fall kann man ein Userform1.Repaint einsetzen, damit VBA die Userform aktuell neu zeichnet.
Gruss Daniel

Anzeige
AW: Ladebalken ProgressBar
26.09.2015 20:07:25
Noureddine
Hallo Daniel,
ich werde wahrscheinlich die b1-Variante nehmen.
Vielen Dank.

AW: Ladebalken ProgressBar
26.09.2015 20:05:49
matthias
Hallo Noureddine,
du musst zunächst definieren wie genau dein Fortschritt ermittelt werden soll. Die Prozentzahl kommt ja nicht von irgendwo zugeflogen, nehme ich an. Meist hat man Schleifen, deren Durchgänge man im Vorhinein bestimmen kann. Mit jedem Durchlauf lässt man dabei einen Zähler mitlaufen. Der Fortschritt ist dann Zähler/AnzahlDurchgänge.
Am besten wäre du würdest uns dein Makro zur Verfügung stellen, günstigerweise mit Beispieldatei, dann können wir dir dabei helfen, eventuell sogar noch etwas optimieren um den Ablauf zu beschleunigen.
lg Matthias

Anzeige
AW: Ladebalken ProgressBar
27.09.2015 14:02:27
Michael
Hallo,
kann man diese Anzeige auch mitten oder in A1(MSG Box) im Tabellenblatt laufen lassen?
Denn ganz unten schaut keiner hin.

AW: Ladebalken ProgressBar
27.09.2015 20:12:41
matthias
Hallo Michael,
deine Art MsgBox wäre Möglichkeit B von Daniels Vorschlägen. Eine Userform ist ein Fenster welches sich öffnet und in dem dein Balken dann fortschreitet.
lg Matthias

AW: Ladebalken ProgressBar
27.09.2015 20:17:36
Michael
Hallo Matthias,
wie geht das ?

AW: Ladebalken ProgressBar
28.09.2015 13:27:15
matthias
Hallo Michael,
https://www.herber.de/bbs/user/100441.xlsm
Zu den grafischen Objekten hat Sepp bereits eine optisch viel schönere Lösung geäußert, jedoch muss man dazu sagen, dass dies nicht die optimalste Variante inpunkto Geschwindigkeit ist.
Eine Userform kann man genau wie ein Modul mit "Rechtsklick" -&gt "Einfügen" im Projekt-Explorer erstellen. Mit einem Doppelklick auf die Userform gelangst du in den Code-Bereich der Form.
Zur genaueren Bedienung verweise ich jedoch auf die Suchfunktion des Forums bzw. Google.
Eine Grundstruktur wie man so eine Progressbar anlegen kann, siehst du sowohl bei Sepp's als auch meiner Lösung. Daniels Tipps sind dabei Gold wert.
Zum Schluss kann ich mich nur nochmal wiederholen: Wir helfen euch gern dabei, jedoch ist dies erheblich leichter, wenn man uns Beispielmappen und Makros zur Verfügung stellt.
lg Matthias

Anzeige
Beispiel Code
29.09.2015 02:14:40
Michl
Hallo,
anbei mein Code.
Leider darf ich von der Arbeit aus meine Datei nicht hochladen.
Sub freieLagerplätze()
' Makro1 Makro
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "WH25"
Range("B36").Select
Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze WH25. _
txt", Origin:=xlWindows, _
StartRow:=9, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(10 _
, 1)), TrailingMinusNumbers:=True
Columns("A:B").Select
Selection.Copy
Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Range("D11").Select
Sheets("Tabelle2").Select
Sheets("Tabelle2").Name = "GD65"
Range("C34").Select
Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze GD65.txt",  _
Origin:=xlWindows, _
StartRow:=7, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:=";", FieldInfo:=Array(Array(1, 1 _
), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
Columns("A:C").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Range("G12").Select
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Sheets("Tabelle3").Select
Sheets("Tabelle3").Name = "RB umwandeln"
Range("C30").Select
ChDir "G:\Transfer\Allgemein\WE"
Workbooks.Open Filename:= _
"G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
Sheets("RB umwandeln").Select
Columns("A:B").Select
Range("A166").Activate
Application.CutCopyMode = False
Selection.Copy
Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Range("D13").Select
Sheets("Tabelle4").Select
Sheets("Tabelle4").Name = "belegte Lagerplätze"
Range("D39").Select
Application.CutCopyMode = False
Workbooks.Open Filename:= _
"G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
ActiveWindow.SmallScroll Down:=-15
Sheets("belegte Lagerplätze").Select
ActiveWindow.SmallScroll Down:=-144
Columns("A:B").Select
Selection.Copy
Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
Range("A1").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D11").Select
Sheets("GD65").Select
Sheets("Tabelle5").Select
Sheets("Tabelle5").Name = "Maße Rollregal"
Workbooks.Open Filename:= _
"G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
Sheets("Maße Rollregal").Select
Columns("A:C").Select
Selection.Copy
Windows("Anzahl freie Lagerplätze Neu.xlsb").Activate
Range("H41").Select
Sheets("Maße Rollregal").Select
Range("A1").Select
ActiveSheet.Paste
Sheets("Tabelle6").Select
Sheets.Add
Sheets("Tabelle1").Select
Sheets("Tabelle1").Name = "Auswertung"
Range("G37").Select
Sheets("Auswertung").Select
Range("D11").Select
Application.Run "PERSONAL.xlsm!freieLagerplätze1"
Application.Run "PERSONAL.xlsm!freieLagerplätze2"
Sheets("WH25").Select
Application.Run "PERSONAL.xlsm!freieLagerplätze3"
Application.Run "PERSONAL.xlsm!freieLagerplätze4"
Application.Run "PERSONAL.xlsm!freieLagerplätze6"
Columns("C:C").ColumnWidth = 2.29
Columns("C:C").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Columns("F:F").ColumnWidth = 2
Columns("F:F").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Columns("J:J").ColumnWidth = 2
Columns("J:J").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("K4").Select
Application.Run "PERSONAL.xlsm!freieLagerplätze7"
Range("K4").Select
End Sub
Entwas langer Code, da ich mich in VBA nicht so gut auskenne :-(
Kann man am Anfang so einen Balken laufen lassen( in meinem Code) per MSG Box oder so ?
Danke euch
Liebe Grüße Michl.

Anzeige
AW: Beispiel Code
29.09.2015 11:53:28
Daniel
Hi
bei diesem Code solltest du dir nicht Gedanken über einen Fortschrittsbalken machen, sondern deine Zeit lieber investieren, um den Code zu beschleunigen.
lies dir das mal durch (und auch die dazugehörigen Folgeseiten):
http://www.online-excel.de/excel/singsel_vba.php?f=78
http://www.online-excel.de/excel/singsel_vba.php?f=60
als weiterer Hinweis:
versuche wenn möglich Zellen, die gleich bearbeitet werden, in einen Schritt gleichzeitig zu bearbeiten:
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit

lässt sich in einem Schritt ausführen mit:
Columns("B:C").EntireColumn.AutoFit

dies funktioniert oft auch bei nicht zusammenhängendne Zellbereichen:
Columns("B:B,D:D,F:F").EntireColumn.AutoFit
Gruß Daniel

Anzeige
AW: Beispiel Code
29.09.2015 17:02:28
matthias
Hallo Michl,
ich habe mir erlaubt deinen Code von etlichen Select-Aktionen zu entrümpeln und vorallem auch die geöffneten Mappen nach Bearbeitung zu schließen. Dies verbraucht alles Ressourcen!
Zusätzlich ist nun die Bildschirmaktualisierung und die Formel-Neuberechnung während der Laufzeit des Codes deaktiviert um das ganze zu beschleunigen.
Die Formatierung der Spalten zum Ende hin kann man ebenfalls zusammenfassen.
Kleiner Tipp: Eine einheitliche Struktur, Leerzeilen zur Trennung von zusammenhängenden Aktionen, Kommentare machen das Lesen erheblich leichter.
Sub freieLagerplätze()
Dim wksWH25 As Worksheet, wksGD65 As Worksheet, wksRB As Worksheet, wksLP As Worksheet, _
wksMR As Worksheet, wksAusw As Worksheet
'Bildschirmaktualisierung + Formelberechnung aus
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Tabellenblätter festlegen
Set wksWH25 = ThisWorkbook.Sheets("Tabelle1")
Set wksGD65 = ThisWorkbook.Sheets("Tabelle2")
Set wksRB = ThisWorkbook.Sheets("Tabelle3")
Set wksLP = ThisWorkbook.Sheets("Tabelle4")
Set wksMR = ThisWorkbook.Sheets("Tabelle5")
Set wksAusw = Worksheets.Add(After:=wksMR)
wksWH25.Name = "WH25"
wksGD65.Name = "GD65"
wksRB.Name = "RB umwandeln"
wksLP.Name = "belegte Lagerplätze"
wksMR.Name = "Maße Rollregal"
wksAusw.Name = "Auswertung"
'Kopieren aus WH25
Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze WH25.txt", _
Origin:=xlWindows, StartRow:=9, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(10, 1)), TrailingMinusNumbers:=True
Columns("A:B").Copy Destination:=wksWH25.Range("A1")
ActiveWorkbook.Close
'Kopieren aus GD65
Workbooks.OpenText Filename:="G:\Transfer\Allgemein\Datei Txt\freie Lagerplätze GD65.txt", _
Origin:=xlWindows, StartRow:=7, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:=";", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
Columns("A:C").Copy Destination:=wksGD65.Range("A1")
ActiveWorkbook.Close
wksGD65.Columns("B:C").EntireColumn.AutoFit
'Kopieren aus freie Lagerplätze
Workbooks.Open Filename:="G:\Transfer\Allgemein\WE\Makro frei Lagerplätze.xlsb"
Sheets("RB umwandeln").Columns("A:B").Copy Destination:=wksRB.Range("A1")
Sheets("belegte Lagerplätze").Columns("A:B").Copy Destination:=wksLP.Range("A1")
wksLP.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Maße Rollregal").Columns("A:C").Copy Destination:=wksMR.Range("A1")
ActiveWorkbook.Close
'Auswertung
wksAusw.Select
Application.Run "PERSONAL.xlsm!freieLagerplätze1"
Application.Run "PERSONAL.xlsm!freieLagerplätze2"
wksWH25.Select
Application.Run "PERSONAL.xlsm!freieLagerplätze3"
Application.Run "PERSONAL.xlsm!freieLagerplätze4"
Application.Run "PERSONAL.xlsm!freieLagerplätze6"
'Formatierung
Columns("C").ColumnWidth = 2.29
Union(Columns("F"), Columns("J")).ColumnWidth = 2
With Union(Columns("C"), Columns("F"), Columns("J")).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Application.Run "PERSONAL.xlsm!freieLagerplätze7"
'Bildschirmaktualisierung + Formelberechnung ein
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Das Makro, ohne die Untermakros zu berücksichten, ist in unter 10 Sekunden erledigt. Ohne die anderen Makros näher zu kennen, lässt sich eine Progressbar in diesem Fall nicht wirklich empfehlen.
lg Matthias

Anzeige
Daniel, du hast Recht...Leider bin ich zu DOOF :-(
29.09.2015 23:12:18
Michl
Hallo Matthias,
ohmannnn Danke ersteinmal für diene Hilfe.
Anbei meine weiteren Codes, bei Code freie Lagerplätze 2 kommt ein Fehler :
Sub freieLagerplätze1()
Dim loletzte As Long
Dim loA As Long
Dim dblSum As Double
Dim DblMitt As Double
loletzte = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Application.EnableEvents = False
For loA = loletzte To 2 Step -1
If Application.WorksheetFunction.CountIf(Range(Cells(2, 1), Cells(loA, 1)), Cells(loA, 1)) > _
1 Then Rows(loA).Delete Shift:=xlUp
Next
End Sub

Sub freieLagerplätze2()
Dim lngZeile As Long
Dim lngLetzte As Long
lngZeile = 1
With Worksheets("WH25")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows. _
Count)
With .Range(.Cells(1, 1), .Cells(lngLetzte, 1))
Do
.Replace What:=Worksheets("RB umwandeln").Cells(lngZeile, 1).Value, _
Replacement:=Worksheets("RB umwandeln").Cells(lngZeile, 2).Value, lookat:=xlPart _
, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
lngZeile = lngZeile + 1
Loop While Worksheets("RB umwandeln").Cells(lngZeile, 1)  ""
End With
End With
End Sub

Sub freieLagerplätze3()
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim i As Long, j As Long
Dim raA As Range
Dim wksA As Worksheet
Dim wksB As Worksheet
Set wksA = Sheets("WH25") ' Tabellennamen anpassen; Tabelle in der gelöscht wird
Set wksB = Sheets("GD65") ' Tabellennamen anpassen; Tabelle in der die Werte in Spalte A  _
gelistet sind
With wksB
loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
End With
With wksA
loLetzte1 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
For i = 2 To loLetzte1
For j = 2 To loLetzte2
If Trim(.Cells(i, 1)) = Trim(wksB.Cells(j, 1)) Then
If raA Is Nothing Then
Set raA = Rows(i)
Else
Set raA = Union(raA, Rows(i))
End If
End If
Next j
Next i
End With
If Not raA Is Nothing Then
raA.Delete
Set raA = Nothing
End If
End Sub

Sub freieLagerplätze4()
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim i As Long, j As Long
Dim raA As Range
Dim wksA As Worksheet
Dim wksB As Worksheet
Set wksA = Sheets("WH25") ' Tabellennamen anpassen; Tabelle in der gelöscht wird
Set wksB = Sheets("belegte Lagerplätze") ' Tabellennamen anpassen; Tabelle in der die Werte  _
in Spalte A gelistet sind
With wksB
loLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
End With
With wksA
loLetzte1 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
For i = 2 To loLetzte1
For j = 2 To loLetzte2
If Trim(.Cells(i, 1)) = Trim(wksB.Cells(j, 1)) Then
If raA Is Nothing Then
Set raA = Rows(i)
Else
Set raA = Union(raA, Rows(i))
End If
End If
Next j
Next i
End With
If Not raA Is Nothing Then
raA.Delete
Set raA = Nothing
End If
End Sub
Sub freieLagerplätze6()
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
ActiveCell.FormulaR1C1 = "test"
Range("B2").Select
ActiveCell.FormulaR1C1 = "KP2_CCG1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "test"
Range("B3").Select
ActiveCell.FormulaR1C1 = "KP2_CCG2"
Range("A4").Select
ActiveCell.FormulaR1C1 = "test"
Range("B4").Select
ActiveCell.FormulaR1C1 = "KD2_30x40"
Range("C5").Select
Sheets("Auswertung").Select
Cells.Select
Selection.ClearContents
Sheets("Wh25").Select
Range("C2").Select
Application.Run "PERSONAL.xlsm!freieLagerplätzeAufteilen"
Sheets("Auswertung").Select
Columns("J:K").Select
Selection.ClearContents
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Range("A3").Select
ActiveCell.FormulaR1C1 = "Lagerplatz"
Range("B3").Select
ActiveCell.FormulaR1C1 = "Feldtyp"
Range("D3").Select
ActiveCell.FormulaR1C1 = "Lagerplatz"
Range("E3").Select
ActiveCell.FormulaR1C1 = "Feldtyp"
Range("G3").Select
ActiveCell.FormulaR1C1 = "Lagerplatz"
Range("H3").Select
ActiveCell.FormulaR1C1 = "Feldtyp"
Range("I3").Select
ActiveCell.FormulaR1C1 = "Maße"
Range("G1:I2").Select
Range("I1").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
Columns("G:I").Select
Range("G3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("D1:E2").Select
Selection.Style = "Comma"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("D:E").Select
Range("D3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("B:B").ColumnWidth = 11.57
Range("A1:B2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("A:B").Select
Range("A3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C1").Select
Rows("3:3").RowHeight = 16.5
Rows("2:2").RowHeight = 18.75
Columns("C:C").ColumnWidth = 15.57
Columns("C:C").ColumnWidth = 18.86
Rows("1:1").RowHeight = 18
Range("C1:C3").Select
Range("C3").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("K1").Select
Sheets("Auswertung").Select
Sheets.Add
Sheets("Auswertung").Select
Sheets("Auswertung").Move Before:=Sheets(5)
Columns("C:C").ColumnWidth = 7.29
Columns("C:C").ColumnWidth = 7
Columns("C:C").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Columns("F:F").ColumnWidth = 7
Columns("F:F").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Columns("J:J").ColumnWidth = 7
Columns("J:J").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Columns("F:F").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Columns("J:J").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("J:J").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("J:J").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("L1").Select
ActiveCell.FormulaR1C1 = "Auswertung"
Range("L2").Select
ActiveCell.FormulaR1C1 = "KP2_CCG2"
Range("M2").Select
ActiveCell.FormulaR1C1 = "KP2_CCG1"
Range("N2").Select
ActiveCell.FormulaR1C1 = "KD2_30x40"
Range("L1:N1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("L1:N2").Select
Selection.Font.Bold = True
Range("L1:N1").Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("L2:N2").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("N5").Select
Columns("L:L").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Range("L1:N1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("L2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("M2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("N2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("L1:N3").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("L3").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-10]:R[996]C[-10])"
Range("M3").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-8]:R[996]C[-8])"
Range("N3").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[1]C[-6]:R[996]C[-6])"
Range("L3:N3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection.Font
.Name = "Arial"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("O6").Select 'hier kommtrein
End Sub

Sub freielagerplätze7()
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 12
Range("C1:C2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("C1:C2").Select
ActiveCell.FormulaR1C1 = "Info"
Columns("C:C").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("G:G").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 12
Range("G1:G2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("G1:G2").Select
ActiveCell.FormulaR1C1 = "Info"
Columns("G:G").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 12
Range("L1:L2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Info"
Columns("L:L").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("C:C").Select
Selection.Font.Bold = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("C1:C2").Select
Selection.Font.Bold = True
Columns("N:N").ColumnWidth = 6
Columns("R:R").ColumnWidth = 20
Columns("C:C").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("C1:C2").Select
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Arial"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Columns("G:G").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("G1:G2").Select
With Selection.Font
.Name = "Arial"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Columns("L:L").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("L1:L2").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With Selection.Font
.Name = "Arial"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("N4").Select
Range("S1:U1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Columns("S:U").Select
Range("S2").Activate
Selection.ColumnWidth = 4
Columns("S:U").Select
Range("S2").Activate
Selection.Font.Bold = True
Range("S1:U2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.AutoFill Destination:=Range("S1:AV2"), Type:=xlFillDefault
Range("S1:AV2").Select
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
Range("S2:AV3").Select
Range("S3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("S:AV").Select
Range("S2").Activate
Selection.ColumnWidth = 4
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 21
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
Range("S2").Select
ActiveCell.FormulaR1C1 = "C2"
Range("T2").Select
ActiveCell.FormulaR1C1 = "C1"
Range("U2").Select
ActiveCell.FormulaR1C1 = "KD"
Range("S2:U2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("S2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 15773696
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("T2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("U2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("S1:U1").Select
ActiveCell.FormulaR1C1 = "Lager 10"
Range("U2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("S2:U2").Select
Selection.AutoFill Destination:=Range("S2:AV2"), Type:=xlFillCopy
Range("S2:AV2").Select
Range("S1:U1").Select
Selection.AutoFill Destination:=Range("S1:AS1"), Type:=xlFillDefault
Range("S1:AS1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AT1:AV1").Select
ActiveCell.FormulaR1C1 = "Tabakhalle"
Range("AT1:AV1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("V3:X3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AB3:AD3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AH3:AJ3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AN3:AP3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AT3:AV3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("S3:AV3").Select
Range("AV3").Activate
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("V1:X1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AB1:AD1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AH1:AJ1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AN1:AP1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("AT1:AV1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("AH1:AJ1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("AB1:AD1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("V1:X1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("V3:X3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("AB3:AD3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("AH3:AJ3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("AN3:AP3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("AT3:AV3").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S6:Y7").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Rollregal"
Range("S6:Y7").Select
Selection.Font.Bold = False
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("S8:U8").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("V8:W8").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("X8:Y8").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("S8:Y8").Select
Selection.AutoFill Destination:=Range("S8:Y21"), Type:=xlFillDefault
Range("S8:Y21").Select
Range("S6:Y21").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("S8:U8").Select
ActiveCell.FormulaR1C1 = "Gang"
Range("S8:U8").Select
Selection.AutoFill Destination:=Range("S8:U21"), Type:=xlFillDefault
Range("S8:U21").Select
Range("V8:W8").Select
ActiveCell.FormulaR1C1 = "12"
Range("V9:W9").Select
ActiveCell.FormulaR1C1 = "14"
Range("V10:W10").Select
ActiveCell.FormulaR1C1 = "44"
Range("V11:W11").Select
ActiveCell.FormulaR1C1 = "46"
Range("V12:W12").Select
ActiveCell.FormulaR1C1 = "53"
Range("V13:W13").Select
ActiveCell.FormulaR1C1 = "61"
Range("V14:W14").Select
ActiveCell.FormulaR1C1 = "62"
Range("V15:W15").Select
ActiveCell.FormulaR1C1 = "64"
Range("V16:W16").Select
ActiveCell.FormulaR1C1 = "66"
Range("V17:W17").Select
ActiveCell.FormulaR1C1 = "67"
Range("V18:W18").Select
ActiveCell.FormulaR1C1 = "69"
Range("V19:W19").Select
ActiveCell.FormulaR1C1 = "70"
Range("V20:W20").Select
ActiveCell.FormulaR1C1 = "72"
Range("V21:W21").Select
ActiveCell.FormulaR1C1 = "74"
Range("S21:Y21").Select
Selection.AutoFill Destination:=Range("S21:Y23"), Type:=xlFillFormats
Range("S21:Y23").Select
Range("S21:U21").Select
Selection.AutoFill Destination:=Range("S21:U23"), Type:=xlFillDefault
Range("S21:U23").Select
Range("V22:W22").Select
ActiveCell.FormulaR1C1 = "1"
Range("V23:W23").Select
ActiveCell.FormulaR1C1 = "3"
Range("S22:U22").Select
ActiveCell.FormulaR1C1 = "Tabak  Gang"
Range("S23:U23").Select
ActiveCell.FormulaR1C1 = "Tabak  Gang"
Range("V8:W23").Select
Selection.Font.Bold = True
Range("S9:Y9").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S11:Y11").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S13:Y13").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S15:Y15").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S17:Y17").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S19:Y19").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S21:Y21").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Range("S22:Y23").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10498160
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
Range("X8:Y23").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("N1").Select
Range("S3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-18],""?-02-*"")+COUNTIF(C[-18],""?-03-*"")+COUNTIF(C[-18],""?-04-*"")+ _
COUNTIF(C[-18],""?-05-*"")+COUNTIF(C[-18],""?-06-*"")"
Range("T3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-15],""?-02-*"")+COUNTIF(C[-15],""?-03-*"")+COUNTIF(C[-15],""?-04-*"")+ _
COUNTIF(C[-15],""?-05-*"")+COUNTIF(C[-15],""?-06-*"")"
Range("V3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-21],""?-10-*"")+COUNTIF(C[-21],""?-11-*"")+COUNTIF(C[-21],""?-12-*"")+ _
COUNTIF(C[-21],""?-13-*"")+COUNTIF(C[-21],""?-14-*"")+COUNTIF(C[-21],""?-15-*"")"
Range("W3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-18],""?-10-*"")+COUNTIF(C[-18],""?-11-*"")+COUNTIF(C[-18],""?-12-*"")+ _
COUNTIF(C[-18],""?-13-*"")+COUNTIF(C[-18],""?-14-*"")+COUNTIF(C[-18],""?-15-*"")"
Range("X3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-15],""?-12-*"")+COUNTIF(C[-15],""?-14-*"")"
Range("Y3").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-24],""?-20-*"")"
Range("Z3").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-21],""?-20-*"")"
Range("AB3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-27],""?-30-*"")+COUNTIF(C[-27],""?-31-*"")+COUNTIF(C[-27],""?-32-*"")+ _
COUNTIF(C[-27],""?-33-*"")+COUNTIF(C[-27],""?-34-*"")+COUNTIF(C[-27],""?-35-*"")+COUNTIF(C[-27],""?-36-*"")+COUNTIF(C[-27],""?-37-*"")"
Range("AC3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-24],""?-30-*"")+COUNTIF(C[-24],""?-31-*"")+COUNTIF(C[-24],""?-32-*"")+ _
COUNTIF(C[-24],""?-33-*"")+COUNTIF(C[-24],""?-34-*"")+COUNTIF(C[-24],""?-35-*"")+COUNTIF(C[-24],""?-36-*"")+COUNTIF(C[-24],""?-37-*"")"
Range("AE3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-30],""?-40-*"")+COUNTIF(C[-30],""?-41-*"")+COUNTIF(C[-30],""?-42-*"")+ _
COUNTIF(C[-30],""?-43-*"")+COUNTIF(C[-30],""?-44-*"")+COUNTIF(C[-30],""?-45-*"")+COUNTIF(C[-30],""?-46-*"")"
Range("AF3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-27],""?-40-*"")+COUNTIF(C[-27],""?-41-*"")+COUNTIF(C[-27],""?-42-*"")+ _
COUNTIF(C[-27],""?-43-*"")+COUNTIF(C[-27],""?-44-*"")+COUNTIF(C[-27],""?-45-*"")+COUNTIF(C[-27],""?-46-*"")"
Range("AG3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-24],""?-44-*"")+COUNTIF(C[-24],""?-46-*"")"
Range("AH3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-33],""?-50-*"")+COUNTIF(C[-33],""?-51-*"")+COUNTIF(C[-33],""?-52-*"")+ _
COUNTIF(C[-33],""?-53-*"")"
Range("AI3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-30],""?-50-*"")+COUNTIF(C[-30],""?-51-*"")+COUNTIF(C[-30],""?-52-*"")+ _
COUNTIF(C[-30],""?-53-*"")+COUNTIF(C[-30],""?-51-*"")"
Range("AJ3").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-27],""?-53-*"")"
Range("AK3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-36],""?-60-*"")+COUNTIF(C[-36],""?-61-*"")+COUNTIF(C[-36],""?-62-*"")+ _
COUNTIF(C[-36],""?-63-*"")+COUNTIF(C[-36],""?-64-*"")+COUNTIF(C[-36],""?-65-*"")+COUNTIF(C[-36],""?-66-*"")+COUNTIF(C[-36],""?-67-*"")+COUNTIF(C[-36],""?-68-*"")+COUNTIF(C[-36],""?-69-*"")"
Range("AL3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-33],""?-60-*"")+COUNTIF(C[-33],""?-61-*"")+COUNTIF(C[-33],""?-62-*"")+ _
COUNTIF(C[-33],""?-63-*"")+COUNTIF(C[-33],""?-64-*"")+COUNTIF(C[-33],""?-65-*"")+COUNTIF(C[-33],""?-66-*"")+COUNTIF(C[-33],""?-67-*"")+COUNTIF(C[-33],""?-68-*"")+COUNTIF(C[-33],""?-69-*"")"
Range("AM3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-30],""?-61-*"")+COUNTIF(C[-30],""?-62-*"")+COUNTIF(C[-30],""?-63-*"")+ _
COUNTIF(C[-30],""?-64-*"")+COUNTIF(C[-30],""?-65-*"")+COUNTIF(C[-30],""?-66-*"")+COUNTIF(C[-30],""?-67-*"")+COUNTIF(C[-30],""?-68-*"")+COUNTIF(C[-30],""?-69-*"")"
Range("AO3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-36],""?-70-*"")+COUNTIF(C[-36],""?-71-*"")+COUNTIF(C[-36],""?-72-*"")+ _
COUNTIF(C[-36],""?-73-*"")+COUNTIF(C[-36],""?-74-*"")"
Range("AP3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-33],""?-70-*"")+COUNTIF(C[-33],""?-71-*"")+COUNTIF(C[-33],""?-72-*"")+ _
COUNTIF(C[-33],""?-73-*"")+COUNTIF(C[-33],""?-74-*"")"
Range("AQ3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-42],""?-80-*"")+COUNTIF(C[-42],""?-81-*"")"
Range("AR3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-39],""?-80-*"")+COUNTIF(C[-39],""?-81-*"")"
Range("AT3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-45],""5-01-*"")+COUNTIF(C[-45],""5-02-*"")+COUNTIF(C[-45],""5-03-*"")"
Range("AU3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-42],""5-01-*"")+COUNTIF(C[-42],""5-02-*"")+COUNTIF(C[-42],""5-03-*"")"
Range("AV3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-39],""5-01-*"")+COUNTIF(C[-39],""5-02-*"")+COUNTIF(C[-39],""5-03-*"")"
Range("S3:AV3").Select
Selection.NumberFormat = "0"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("X8:Y8").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-12-*"")"
Range("X9:Y9").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-14-*"")"
Range("X10:Y10").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-14-*"")"
Range("X11:Y11").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-46-*"")"
Range("X12:Y12").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-53-*"")"
Range("X13:Y13").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-61-*"")"
Range("X14:Y14").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-62-*"")"
Range("X15:Y15").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-64-*"")"
Range("X16:Y16").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-66-*"")"
Range("X17:Y17").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-67-*"")"
Range("X18:Y18").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-69-*"")"
Range("X19:Y19").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-70-*"")"
Range("X20:Y20").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-72-*"")"
Range("X21:Y21").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-74-*"")"
Range("X22:Y22").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-01-*"")"
Range("X23:Y23").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-02-*"")"
Range("X24:Y24").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("X8:Y24").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Range("X8:Y24").Select
Range("X24").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-16]C:R[-1]C)"
Range("X8:Y24").Select
Range("Y8").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y9").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y10").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y11").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y12").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y13").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y14").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y15").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y16").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y17").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y18").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y19").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y20").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y21").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y22").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y23").Activate
ActiveCell.FormulaR1C1 = ""
Range("X8:Y24").Select
Range("Y24").Activate
Range("X24:Y24").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("S3:AW3").Select
Range("AW3").Activate
ActiveCell.FormulaR1C1 = "=SUM(RC[-30]:RC[-1])"
Range("S3:AW3").Select
ActiveWindow.SmallScroll ToRight:=2
Range("AX9").Select
Columns("AW:AW").ColumnWidth = 8
Columns("AW:AW").ColumnWidth = 6.43
Range("AW3").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("AW3").Select
Selection.ClearContents
Range("AW2").Select
ActiveCell.FormulaR1C1 = "C2"
Range("AT2:AV2").Select
Selection.AutoFill Destination:=Range("AT2:AY2"), Type:=xlFillDefault
Range("AT2:AY2").Select
Columns("AW:AY").Select
Selection.ColumnWidth = 8.14
Range("AW1:AY1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Kontrolle Auswertung"
Range("AW1:AY1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("AW1:AY3").Select
Range("AW3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("AW3:AY3").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("AW2").Select
ActiveCell.FormulaR1C1 = "C2"
Range("AW3").Select
ActiveCell.FormulaR1C1 = _
"=RC[-30]+RC[-27]+RC[-24]+RC[-21]+RC[-18]+RC[-15]+RC[-12]+RC[-9]+RC[-6]"
Range("AX3").Select
ActiveCell.FormulaR1C1 = _
"=RC[-30]+RC[-27]+RC[-24]+RC[-21]+RC[-18]+RC[-15]+RC[-12]+RC[-9]+RC[-6]+RC[-3]"
Range("AY3").Select
ActiveCell.FormulaR1C1 = _
"=RC[-30]+RC[-27]+RC[-24]+RC[-21]+RC[-18]+RC[-15]+RC[-12]+RC[-9]+RC[-6]"
Range("AW3:AY3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
Range("AO3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-36],""?-70-*"")+COUNTIF(C[-36],""?-71-*"")+COUNTIF(C[-36],""?-72-*"")+ _
COUNTIF(C[-36],""?-73-*"")+COUNTIF(C[-36],""?-74-*"")"
Range("AN3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-39],""?-70-*"")+COUNTIF(C[-39],""?-71-*"")+COUNTIF(C[-39],""?-72-*"")+ _
COUNTIF(C[-39],""?-73-*"")+COUNTIF(C[-39],""?-74-*"")"
Range("AI3").Select
ActiveCell.FormulaR1C1 = _
"=COUNTIF(C[-30],""?-50-*"")+COUNTIF(C[-30],""?-51-*"")+COUNTIF(C[-30],""?-52-*"")+ _
COUNTIF(C[-30],""?-53-*"")"
Range("X8:Y8").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-12-*"")"
Range("X8:Y8").Select
Selection.AutoFill Destination:=Range("X8:Y23"), Type:=xlFillDefault
Range("X8:Y23").Select
Range("X9:Y9").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-14-*"")"
Range("X10:Y10").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-44-*"")"
Range("X11:Y11").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-46-*"")"
Range("X12:Y12").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-53-*"")"
Range("X13:Y13").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-61-*"")"
Range("X14:Y14").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-62-*"")"
Range("X15:Y15").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-64-*"")"
Range("X16:Y16").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-66-*"")"
Range("X17:Y17").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-67-*"")"
Range("X18:Y18").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-69-*"")"
Range("X19:Y19").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-70-*"")"
Range("X20:Y20").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-72-*"")"
Range("X21:Y21").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""?-74-*"")"
Range("X22:Y22").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-01-*"")"
Range("X23:Y23").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-15],""5-03-*"")"
Columns("S:AY").Select
Range("S2").Activate
Selection.EntireColumn.Hidden = True
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("K3").Select
ActiveCell.FormulaR1C1 = "Maße in cm"
Range("L3").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Range("K4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Maße Rollregal'!C1:C2,2,FALSE)"
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K2000"), Type:=xlFillDefault
Range("I3:L1012").Select
ActiveWorkbook.Worksheets("Auswertung").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Auswertung").Sort.SortFields.Add Key:=Range( _
"I4:I1012"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Auswertung").Sort
.SetRange Range("I3:L1012")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("K:K").Select
Range("K3").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Selection.Font.Bold = False
Selection.Font.Bold = True
Range("N1").Select
Columns("I:J").Select
Range("I3").Activate
Selection.Font.Bold = False
Range("J15").Select
Range("I1:K2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Range("E1:F2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Range("A1:B2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.ColumnWidth = 5.57
Range("A3").Select
ActiveCell.FormulaR1C1 = "Gang"
Range("F3").Select
ActiveCell.FormulaR1C1 = "Gang"
Range("H7").Select
Columns("F:F").ColumnWidth = 4.57
Range("K3").Select
ActiveCell.FormulaR1C1 = "Gang"
Range("L4").Select
Columns("K:K").ColumnWidth = 8.29
Range("M9").Select
Range("K1:N2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Selection.Font.Bold = True
Range("F1:H2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A1:C2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("B4").Select
Columns("K:K").ColumnWidth = 8.43
Columns("F:F").ColumnWidth = 8.43
Columns("A:A").ColumnWidth = 8.43
Columns("A:D").Select
Range("A3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("F:I").Select
Range("F3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("K:O").Select
Range("K3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("Q10").Select
Columns("K:K").Select
Range("K3").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("K:K").Select
Range("K3").Activate
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("K3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("F:F").Select
Range("F3").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("F3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").Select
Range("A3").Activate
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("A3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C7").Select
Columns("L:M").Select
Range("L3").Activate
Selection.Font.Bold = False
Range("K4").Select
ActiveCell.FormulaR1C1 = "=MID(RC[1],3,2)"
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K2000"), Type:=xlFillDefault
Range("F4").Select
ActiveCell.FormulaR1C1 = "=MID(RC[1],3,2)"
Range("F4").Select
Selection.AutoFill Destination:=Range("F4:F2000"), Type:=xlFillDefault
Range("A4").Select
ActiveCell.FormulaR1C1 = "=MID(RC[1],3,2)"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A2000"), Type:=xlFillDefault
Range("B5").Select
Range("K1:N2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("F1:H2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("N:N").Select
Range("N3").Activate
Selection.Font.Bold = True
Range("N11").Select
Range("K1:N2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Columns("L:M").Select
Selection.Font.Bold = False
Range("K1:N2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("L3:M3").Select
Selection.Font.Bold = True
Range("L6").Select
Columns("P:P").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Columns("J:J").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Range("A3:O3").Select
Range("O3").Activate
Selection.AutoFilter
Range("O9").Select
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 12.71
Columns("B:B").ColumnWidth = 13.71
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
End Sub
Sub freieLagerplätzeAufteilen()
Dim SpalteZiel As Long
Dim Zelle1 As Range
Dim Zelle2 As Range
SpalteZiel = 1
With Sheets("WH25")
.Range("A:B").Sort key1:=.Cells(1, 2), order1:=xlDescending, Header:=xlYes
Set Zelle2 = .Cells(1, 2)
Do
Set Zelle1 = Zelle2.Offset(1, 0)
If Zelle1.Value = "" Then Exit Sub
Set Zelle2 = .Columns(2).Find(What:=Zelle1.Value, searchdirection:=xlPrevious)
With Sheets("Auswertung")
.Cells(1, SpalteZiel).Value = Zelle1.Value
.Cells(3, SpalteZiel).Resize(1, 2).Value = Zelle1.Worksheet.Range("A1:B1").Value
Range(Zelle1.Offset(0, -1), Zelle2).Copy Destination:=.Cells(4, SpalteZiel)
End With
SpalteZiel = SpalteZiel + 3
Loop
End With
End Sub
Danke Dir
Michl

Anzeige
AW: Daniel, du hast Recht...Leider bin ich zu DOOF :-(
30.09.2015 12:31:17
matthias
Hallo Michl,
ich werd mal drüber schaun, wird aber heut nichts mehr. Ich meld mich dann nochmal.
lg Matthias

AW: Daniel, du hast Recht...Leider bin ich zu DOOF :-(
30.09.2015 13:10:35
Daniel
Hi
wenn du Code hier einstellst, damit wir uns das anschauen und die Fehler für dich suchen, dann solltest du den Code vorher noch ein bisschen überarbeiten und alles überflüssige und nicht benötigte entfernen.
- Lösche alle Zeilen mit .ScrollColumn oder .ScrollRow
- lösche alle "...Select / Selection..." bzw "...Select / ActiveCell..."
dh aus
Range("AW2").Select
ActiveCell.FormulaR1C1 = "C2"

wird
Range("AW2").FormulaR1C1 = "C2"
aus

Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

wird
Columns("I:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
- Lösche in den Zeilen mit Formatierungsbefehlen alle nicht benötigten raus und lasse nur die stehen, die du tatsächlich verändern willst.
Der Code wird dann nicht nur kürzer und schneller, sondern auch übersichlicher und vielleicht findest du deinen Fehler dann selber.
Gruß Daniel

Anzeige
AW: Daniel, du hast Recht...Leider bin ich zu DOOF :-(
30.09.2015 17:58:03
matthias
Hallo Michl,
kannst du mir eine kurze Beschreibung zu den Makros geben, was eigentlich getan werden soll? Eventuell kann man da einen kürzeren Weg finden, gerade bei 6 und 7.
Nach kurzem Überfliegen bin ich soweit, dass ich sagen kann:
  • freieLagerplätze1: doppelte Einträge Spalte A finden und löschen (ersten Datensatz behalten), die Frage ist nur: In welcher Tabelle soll dies geschehen? In deinem Hauptmakro wird zunächst "Auswertung" angewählt, aber ein neu erstelltes TB ist eh leer, von daher sicher nicht das Ziel.
  • freieLagerplätze2: bestimmte Ausdrücke ersetzen (TB "RBumwandeln"), hier ist alles klar
  • freieLagerplätze3: Prüfen ob Zelle im TB "WH25" Spalte A bereits im TB "GD65" Spalte A vorhanden ist, falls ja Zeile löschen
  • freieLagerplätze4: Prüfen ob Zelle im TB "WH25" Spalte A bereits im TB "belegte Lagerplätze" Spalte A vorhanden ist, falls ja Zeile löschen
  • freieLagerplätze6: Anlegen der Auswertetabelle; kann man nicht eine Vorlage kopieren, statt wertvolle Sekunden damit zu verbringen alle Zellen zu färben, umranden usw.?
  • freieLagerplätze7: gilt gleiches wie für freieLagerplätze6
  • freieLagerplätzeAufteilen: Du sortierst deine Einträge nach Feldtypen, teilst deine Lagerplätze in Feldtypen auf und kopierst diese in die Auswertung.

  • Falls ich etwas falsch aufgefasst haben sollte, korrigiere mich bitte.
    Zum Thema Auswertung wäre es günstiger ein Tabellenblatt "Auswertung_Vorlage" was bereits perfekt aussieht händig zu erstellen und dann mit dem Makro zu kopieren und in "Auswertung" umzunennen. Das dauert nur einen Sekundenbruchteil und bedarf 2 Zeilen Code. Dein Makro "freieLagerplätzeAufteilen" müsste man dann nur dahingehend ändern, dass es beim kopieren den Feldtyp erfasst und in die richtige Spalte kopiert (statt wie jetzt die erste Spalte zu nehmen und bei jedem Typ 3 Spalten weiter zu rücken), sowie deine Formel für den Gang einfügt.
    Kurze Frage: Was soll eigentlich mit einem vierten/fünften usw. Feldtypen passieren oder gibt es die nicht? Momentan sieht es ja so aus, dass alle Feldtypen in die Auswertung kopiert werden, aber der vierte wird komplett gelöscht, ein fünfter wird mit deiner Auswertung teilweise überschrieben.
    Zudem sind die Feldtypen in der Auswertung eh sortiert, ist die Spalte Feldtyp bei allen dreien denn dann noch notwendig? Steht doch eh immer das gleiche drinn, von daher überflüssige Daten, richtig?
    lg Matthias

    Danke Daniel für deine Tipppppps :-)
    01.10.2015 01:03:22
    Michl
    Hallo Matthias,
    danke ersteinmal für deine wertvolle Zeit und deine Hile :-)
    Ich wewrde die Dateien zu mir nach Hause Mailen. Ich hoffe, das ich es dann hier Hochladen kann.
    Somit hast du Alle TXT Dateien und die Excel Datei.
    Frage1:
    Nach kurzem Überfliegen bin ich soweit, dass ich sagen kann:
    •freieLagerplätze1: doppelte Einträge Spalte A finden und löschen (ersten Datensatz behalten), die Frage ist nur: In welcher Tabelle soll dies geschehen? In deinem Hauptmakro wird zunächst "Auswertung" angewählt, aber ein neu erstelltes TB ist eh leer, von daher sicher nicht das Ziel.

    Dies geschieht in der TB WH25
    Frage2:
    Kurze Frage: Was soll eigentlich mit einem vierten/fünften usw. Feldtypen passieren oder gibt es die nicht? Momentan sieht es ja so aus, dass alle Feldtypen in die Auswertung kopiert werden, aber der vierte wird komplett gelöscht, ein fünfter wird mit deiner Auswertung teilweise überschrieben.
    Zudem sind die Feldtypen in der Auswertung eh sortiert, ist die Spalte Feldtyp bei allen dreien denn dann noch notwendig? Steht doch eh immer das gleiche drinn, von daher überflüssige Daten, richtig?

    Ich glaube durch die Datein wirst du schlauer :-)
    Nocheinmal Besten Dank, weiß gar nicht, wie ich das wieder gut machen kann.
    Liebe Grüße Michl

    AW: Danke Daniel für deine Tipppppps :-)
    01.10.2015 15:48:13
    Michl
    Hallo:-)
    anbei die Dateien:
    die erste Datei heißt :Anzahl freie Lagerplätze NEU:
    https://www.herber.de/bbs/user/100531.xlsm
    Ich mußte die Datei kleiner machen
    TB gd65 hat ca. 20000 Zeilen.
    Jetzt die TXT Dateien:
    freie Lagerplätze GD65 die mußte ich auch kleiner machen max 300KB
    https://www.herber.de/bbs/user/100532.txt
    freie Lagerplätze WH25:
    https://www.herber.de/bbs/user/100533.txt
    Ich hoffe , das du dadurch einen Besseren Überblick bekommst.
    Danke MICHL

    14 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige