habe mir mit eurer Hilfe ein Makro "gestrickt". Daten aus einer Zeiterfassung werden auf das Wesentliche reduziert und aufbereitet, u.a. erfolgt die Berechnung der Lohnleistung inklusive Zuschläge. Nun habe ich den Grundlohn fest "eingebaut". Wenn dieser sich ändert, muss ich das Makro ändern. Wesentlich besser wäre es natürlich, wenn eine Abfrage beim Starten des Makros kurz fragt, ob die eingestellten Parameter gültig sind. Ich stelle mir das in einer Art pop up vor. In diesem Fenster erscheinen die Lohnarten und die Frage, ob diese korrekt sind. Bei Bedarf, kann man diese anpassen, wenn nicht per Klick auf OK Makro weiter ausführen. Innerhalb des Makros gibt es keinen Textbezug zu den Konditionen, diese sollten dann in dem Fenster fix sein:
Beispiel: Qualifikation A ín Euro 14,05
Qualifikation B in Euro 14,40
In dem fett markierten Bereich befinden sich die Parameter. Gibt es eine Funktion ähnlich wie suchen/ändern, also wenn bei Qualifikation A in Euro 14,50 eingetragen wird, dann ändere alle Werte in der Formel von 14,05 auf 14,50?
Weiß jemand wie das geht, bzw. ob das geht?
Anbei mal das Makro:
Range("A1:AZ10000").Select
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
Range("D1:E10000").Select
Selection.Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1:C10000").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
Range("C1:E10000").Select
Columns("C:C").EntireColumn.AutoFit
Columns("E:E").Select
Selection.EntireColumn.Hidden = True
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
Columns("D:D").Select
Selection.EntireColumn.Hidden = True
Columns("F:F").EntireColumn.AutoFit
Columns("G:M").Select
Selection.EntireColumn.Hidden = True
Columns("O:Q").Select
Selection.EntireColumn.Hidden = True
Columns("T:Y").Select
Selection.EntireColumn.Hidden = True
Range("z2:AB10000").Select
Selection.Replace What:="", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("AC1").Select
ActiveCell.FormulaR1C1 = "Service Logistik"
Range("AD1").Select
ActiveCell.FormulaR1C1 = "Logistik"
Range("AE1").Select
ActiveCell.FormulaR1C1 = "Kasse"
Range("AF1").Select
ActiveCell.FormulaR1C1 = "Kasse Einarb"
Range("AG1").Select
ActiveCell.FormulaR1C1 = "Lohnkosten inkl Zuschläge"
Range("AC1:AG10000").Select
Selection.NumberFormat = "#,##0.00 $"
Range([AC2], [AC2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-25]=10,14.05*RC[-11]+(RC[-3]*0.25*14.05)+(RC[-2]*0.25*14.05)+(RC[-1]*0.5*14.05),0)"
Range([AD2], [AD2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-26]=20,14.05*RC[-12]+(RC[-4]*0.25*14.05)+(RC[-3]*0.25*14.05)+(RC[-2]*0.5*14.05),0)"
Range([AE2], [AE2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-27]=30,14.4*RC[-13]+(RC[-5]*0.25*14.4)+(RC[-4]*0.25*14.4)+(RC[-3]*0.5*14.4),0)"
Range([AF2], [AF2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=IF(RC[-28]=40,14.05*RC[-14]+(RC[-6]*0.25*14.05)+(RC[-5]*0.25*14.05)+(RC[-4]*0.5*14.05),0)"
Range([AG2], [AG2].End(xlDown)).Offset(0, 0).FormulaR1C1 = "=RC[-4]+RC[-3]+RC[-2]+RC[-1]"
Columns("AC:AG").Select
Columns("AC:AG").EntireColumn.AutoFit
ActiveWindow.DisplayZeros = False
Range("A1:AG1").Select
Range("AG1").Activate
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Range("AG1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Columns("Z:AB").Select
Range("AB1").Activate
Selection.EntireColumn.Hidden = True
Range("A1").Select
Columns("AH:AH").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Delete shift:=xlToLeft
Range("AG2").Select
End
Dim z As Long, lZ As Long
lZ = Sheets("currentregion").Cells(65536, 2).End(xlUp).Row
For z = lZ To 1 Step -1
With Sheets("currentregion")
If .Cells(z, 1) = "" Then .Rows(z).Delete
End With
Next
End Sub