Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1172to1176
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

Prozeduren zusammenführen

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
Anzeige
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

Anzeige
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

Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige