Prozeduren zusammenführen
Charly
Ihr habt mir Heute schon sehr geholfen.
Danke nochmals.
Ich bin dabei eine Datei zu optimieren und möchte folgende 7 Makros zusammenführen.
Sub Formel_LV_Menge()
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range
Dim i As Integer
Set Bereich = Sheets("LV").[E3:E518]
Sheets("LV").Activate
[e3].FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Menge))"
[e3].AutoFill Destination:=Bereich, Type:=xlFillDefault
Bereich = Bereich.Value
For i = 3 To 518
If Cells(i, 5).Value = 0 Then
Cells(i, 5).ClearContents 'Value = ""
End If
Next i
Set Bereich = Nothing
End Sub
Sub Formel_LV_N()
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range
Dim i As Integer
Set Bereich = Sheets("LV").[G3:G518]
Sheets("LV").Activate
[g3].FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Nacht))"
[g3].AutoFill Destination:=Bereich, Type:=xlFillDefault
Bereich = Bereich.Value
For i = 3 To 518
If Cells(i, 7).Value = 0 Then
Cells(i, 7).ClearContents 'Value = ""
End If
Next i
Set Bereich = Nothing
End Sub
Sub Formel_LV_S()
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range
Dim i As Integer
Set Bereich = Sheets("LV").[H3:H518]
Sheets("LV").Activate
[h3].FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Sonntag))"
[h3].AutoFill Destination:=Bereich, Type:=xlFillDefault
Bereich = Bereich.Value
For i = 3 To 518
If Cells(i, 8).Value = 0 Then
Cells(i, 8).ClearContents 'Value = ""
End If
Next i
Set Bereich = Nothing
End Sub
Sub Formel_LV_F()
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range
Dim i As Integer
Set Bereich = Sheets("LV").[i3:i518]
Sheets("LV").Activate
[i3].FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Feiertag))"
[i3].AutoFill Destination:=Bereich, Type:=xlFillDefault
Bereich = Bereich.Value
For i = 3 To 518
If Cells(i, 9).Value = 0 Then
Cells(i, 9).ClearContents 'Value = ""
End If
Next i
Set Bereich = Nothing
End Sub
Sub Formel_LV_Summe()
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range
Dim i As Integer
Set Bereich = Sheets("LV").[F3:F518]
Sheets("LV").Activate
[F3].FormulaLocal = "=d3*e3"
[F3].AutoFill Destination:=Bereich, Type:=xlFillDefault
Bereich = Bereich.Value
For i = 3 To 518
If Cells(i, 6).Value = 0 Then
Cells(i, 6).ClearContents 'Value = ""
End If
Next i
Set Bereich = Nothing
End Sub
Sub Formel_LV_Summe_Zu()
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range
Dim i As Long
Set Bereich = Sheets("LV").[J3:J518]
Sheets("LV").Activate
[J3].FormulaLocal = "=(G3*D3*0,1)+(H3*D3*0,2)+WENN(LINKS(A3;1)*1=1;I3*D3*0,2;I3*D3*0,4)"
[J3].AutoFill Destination:=Bereich, Type:=xlFillDefault
Bereich = Bereich.Value
For i = 3 To 518
If Cells(i, 10).Value = 0 Then
Cells(i, 10).ClearContents 'Value = ""
End If
Next i
Set Bereich = Nothing
End Sub
Sub Formel_LV_Gesamt()
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range
Dim i As Integer
Set Bereich = Sheets("LV").[K3:K518]
Sheets("LV").Activate
[K3].FormulaLocal = "=F3+J3"
[K3].AutoFill Destination:=Bereich, Type:=xlFillDefault
Bereich = Bereich.Value
For i = 3 To 518
If Cells(i, 11).Value = 0 Then
Cells(i, 11).ClearContents
End If
Next i
Set Bereich = Nothing
End Sub
Könnt ihr nochmal helfen?Danke
Charly