AW: eine Formel? Warum dann eine XLSm-Datei? ...
06.05.2017 08:56:10
Florian
Ok.
Hier die xlsx Datei und das Makro der xlsm.
Die Datei https://www.herber.de/bbs/user/113362.xlsx wurde aus Datenschutzgründen gelöscht
'Makro zum Anpassen der Seiten beim Jahreswechsel
Sub Jahreswechselmakro()
'Variablen für Firmenübersicht
Dim rng As Range
Dim wks As Worksheet
Dim strFehler As String
Dim i As Long
Dim lngletztezeile As Long
Dim strSep As String
'Variablen für Statistik
Dim q As Integer, j As Integer, k As Integer, l As Integer, m As Integer, p As Integer
Dim n As Integer, o As Integer
Dim c As Range
Dim lngletzterFeiertag As Long
Dim strFT As String
Dim Datum As Date
Dim intAnzahlTage As Integer
Dim strspalte As String
Dim lngzeile As Long, lngZeileUmsatz As Long, lngZeileKunden As Long
'Variablen für online Statistik
Dim r As Integer
Dim s As Integer
'-------------------------------Seite Firmenübersicht--------------------------
'TrennText in Fehlermeldung
strSep = " / "
With ThisWorkbook.Worksheets("Firmenübersicht")
'letzte Zeile
lngletztezeile = .Cells(Rows.Count, 6).End(xlUp).Row
'ersetzen der Formeln in Spalte J (vorletztes Jahr) durch Werte
If .Range("J2").HasFormula Then
With .Range(.Cells(2, 10), .Cells(lngletztezeile - 2, 10))
.Calculate
.Value = .Value
End With
End If
'Einfügen drei neuer Spalten und setzen der Formate
.Columns("G:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Columns("G:I").ColumnWidth = 10
.Columns("G:I").HorizontalAlignment = xlCenter
.Columns("G:G").NumberFormat = "0.00"
.Columns("H:H").NumberFormat = "#,##0"
.Columns("I:I").NumberFormat = "0%"
'Setzen der Überschriften
.Range("G1").Value = Year(Date)
.Range("G1").NumberFormat = "0"
.Range("H1").Value = "#"
.Range("I1").Value = "%"
'Färben der Spalte G
With .Columns("G:G").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
.PatternTintAndShade = 0
End With
'Schleife durchläuft alle Arbeitsblätter und schreibt Umsatz in Firmenübersicht
For Each wks In ActiveWorkbook.Worksheets
'Prüfung ob es sich um Firmenseite handelt
If wks.Name = wks.Range("E1") Then
Set rng = .Columns(6).Find(wks.Name, LookAt:=xlWhole)
'Wenn gefunden, dann schreiben der Werte
If Not rng Is Nothing Then
'Formel für aktuelles Jahr
rng.Offset(0, 1).FormulaR1C1 = "='" & wks.Name & "'!R2C10" 'aus J2
'Formel für vorheriges Jahr
rng.Offset(0, 4).FormulaR1C1 = "='" & wks.Name & "'!R3C10" 'aus J3
Else
'Speichern der nicht gefunden Firmen in einer Variablen
strFehler = wks.Name & strSep & strFehler
End If
End If
Next
If strFehler "" Then strFehler = strSep & strFehler
'Schreiben der Formeln in Spalte H (#)
With .Range(.Cells(2, 8), .Cells(lngletztezeile - 2, 8))
.FormulaR1C1 = "=RC[-1]-RC[2]"
End With
'Schreiben der Formeln in Spalte I (%)
With .Range(.Cells(2, 9), .Cells(lngletztezeile - 2, 9))
.FormulaR1C1 = "=IFERROR((RC[-2]-RC[1])/ABS(RC[1])," & Chr(34) & Chr(34) & ")"
End With
'Schreiben der Werte in letzteZeile (Summe)
.Range("G" & lngletztezeile).Formula = "=SUM(G2:G" & lngletztezeile - 2 & ")"
.Range("H" & lngletztezeile).Formula = "=G" & lngletztezeile & "-J" & lngletztezeile
.Range("I" & lngletztezeile).FormulaR1C1 = "=IFERROR((RC[-2]-RC[1])/ABS(RC[1]),"""")"
End With
'erneute Schleife durch alle Arbeitsblätter - Anpassen der Umsatzspalten
Application.Calculate
For Each wks In ActiveWorkbook.Worksheets
'Prüfung ob es sich um Firmenseite handelt
If wks.Name = wks.Range("E1") Then
'Pfüfung ob es bei aktueller Firma Fehler gab
'Hier die Abfrage, ob wks.name NICHT in der Variable strFehler vorkommt
If InStr(1, strFehler, strSep & wks.Name & strSep) = 0 Then
wks.Range("I3").Value = Year(Date) - 1
wks.Range("I2").Value = Year(Date)
End If
End If
Next
'Schreiben des Datums in Einstellungen A1
ThisWorkbook.Worksheets("Einstellungen").Range("A1") = Year(Date)
'Wenn Variable strFehler belegt, dann zeigen der Fehler
If (strFehler) "" Then MsgBox ("Fehler bei folgenden Firmen. Bitte manuell prüfen." & _
Chr(13) & strFehler)
End Sub