Prozeduren zusammenführen

Forumthread: Prozeduren zusammenführen

Charly

Guten Abend
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

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Prozeduren zusammenführen

Josef
AW: Prozeduren zusammenführen

fcs
Danke

Charly

AW: Prozeduren zusammenführen

15.08.2010 23:45:14

Josef

Hallo Charly,
ungetestet!

Sub Formeln()
  Dim rng As Range


  With Sheets("LV")

    With .Range("E3:E518")
      .FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Menge))"
      .Value = .Value
    End With

    With .Range("G3:G518")
      .FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Nacht))"
      .Value = .Value
    End With

    With .Range("H3:H518")
      .FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Sonntag))"
      .Value = .Value
    End With

    With .Range("I3:I518")
      .FormulaLocal = "=SUMMENPRODUKT((Position=A3)*(Feiertag))"
      .Value = .Value
    End With

    With .Range("F3:F518")
      .FormulaLocal = "=d3*e3"
      .Value = .Value
    End With

    With .Range("J3:J518")
      .FormulaLocal = "=(G3*D3*0,1)+(H3*D3*0,2)+WENN(LINKS(A3;1)*1=1;I3*D3*0,2;I3*D3*0,4)"
      .Value = .Value
    End With

    With .Range("K3:K518")
      .FormulaLocal = "=F3+J3"
      .Value = .Value
    End With

    For Each rng In .Range("E3:K518")
      If rng = 0 Then rng = ""
    Next

  End With

End Sub

Gruß Sepp

AW: Prozeduren zusammenführen

16.08.2010 00:21:03

fcs

Hallo Charly,
verwende zur Bearbeitung der Bereiche eine Subroutine an die Spalte und Formel als Parameter übergeben werden.
Gruß
Franz

Option Explicit
Private wks As Worksheet
Private Zeile_1 As Long, Zeile_L As Long
Sub Formeln_LV()
Set wks = Worksheets("LV")
wks.Activate
Zeile_1 = 3
Zeile_L = 518
Application.ScreenUpdating = False
'Spalte E - Menge
Call Formeln(5, "=SUMMENPRODUKT((Position=A3)*(Menge))")
'Spalte G - Nacht
Call Formeln(7, "=SUMMENPRODUKT((Position=A3)*(Nacht))")
'Spalte H - Sonntag
Call Formeln(8, "=SUMMENPRODUKT((Position=A3)*(Sonntag))")
'Spalte I - Feiertag
Call Formeln(9, "=SUMMENPRODUKT((Position=A3)*(Feiertag))")
'Spalte F - Nacht
Call Formeln(6, "=d3*e3")
'Spalte J - Zu
Call Formeln(10, "=(G3*D3*0,1)+(H3*D3*0,2)+WENN(LINKS(A3;1)*1=1;I3*D3*0,2;I3*D3*0,4)")
'Spalte K - Gesamt
Call Formeln(11, "=F3+J3")
Application.ScreenUpdating = True
End Sub
Private Sub Formeln(Spalte As Long, sFormel As String)
'*** Formel eintragen / Formeln durch Werte ersetzen / Werte loeschen bei Zellen mit Null ***
Dim Bereich As Range, Zelle As Range
With wks
Set Bereich = .Range(.Cells(Zeile_1, Spalte), .Cells(Zeile_L, Spalte))
Bereich.FormulaLocal = sFormel
Bereich.Value = Bereich.Value
For Each Zelle In Bereich
If Zelle.Value = 0 Then
Zelle.ClearContents 'Value = ""
End If
Next Zelle
End With
Set Bereich = Nothing: Set Zelle = Nothing
End Sub

Danke

16.08.2010 03:54:17

Charly

Danke Josef und Franz
Funktioniert Beides.
Die Datei wird immer kleiner.
Klasse
Gruss Charly

Beliebteste Forumthreads (12 Monate)

Forumthread: Prozeduren zusammenführen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread