zelleninhalte löschen funktioniert nicht

Sub selo_berechnung1() Worksheets("gesamtplanung").Activate With ActiveSheet Dim loLetzte As Long Dim loI As Long Dim ZeileEnde, SpalteEnde, y, x, zelle loLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count) For loI = 2 To loLetzte ZeileEnde = loI 'letzte Zeile = loI SpalteEnde = 15 'letzte Spalte = o For y = 14 To SpalteEnde 'Bereich ab Spalte n bis o For x = 2 To ZeileEnde 'Bereich ab Zeile 2 bis letzte Cells(x, y).Select zelle = ActiveCell.Formula If Left(zelle, 1) <> "=" Then Cells(x, y).ClearContents Next x Next y Cells(loI, 14).FormulaLocal = "hier erfolgt ein berechnungsschritt" Cells(loI, 14).NumberFormat = "General" Range(Cells(loI, 14), Cells(loI, 15)).HorizontalAlignment = xlCenter Next loI Range(Cells(loI, 14), Cells(loI, 15)).Font.ColorIndex = 3 End With Worksheets("tabelle3").Activate End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
teste mal, ob dass das Gewünschte macht:
Sub Zellen_in_N_und_O_loeschen_und_formatieren_wenn_M_leer()
    'Voraussetzung: Liste beginnt in Zeile 1 (Überschriften)
    Range("M1").AutoFilter Field:=13, Criteria1:="="
    Range("2:" & [M2].CurrentRegion.Rows.Count).Columns("N:O").SpecialCells(xlCellTypeVisible).ClearContents
    Range("2:" & [M2].CurrentRegion.Rows.Count).Columns("N:N").SpecialCells(xlCellTypeVisible).FormulaLocal = "hier erfolgt ein Berechnungsschritt"
    Range("2:" & [M2].CurrentRegion.Rows.Count).Columns("N:N").SpecialCells(xlCellTypeVisible).NumberFormat = "General"
    Range("2:" & [M2].CurrentRegion.Rows.Count).Columns("N:O").SpecialCells(xlCellTypeVisible).HorizontalAlignment = xlCenter
    Range("2:" & [M2].CurrentRegion.Rows.Count).Columns("N:O").SpecialCells(xlCellTypeVisible).Font.ColorIndex = 3
    [M1].AutoFilter
End Sub

Gruß, Beate

Sub selo_berechnung1() Dim loLetzte As Long Dim zelle Dim ws As Worksheet, rg1 As Range, rg2 As Range 'best. Systemeinstellungen deaktivieren Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False 'Tabelle festlegen Set ws = ThisWorkbook.Worksheets("gesamtplanung") loLetzte = IIf(IsEmpty(ws.Cells(Rows.Count, 2)), ws.Cells(Rows.Count, 2).End(xlUp).Row, ws.Rows.Count) 'Bereich festlegen Set rg1 = ws.Range("N2:O" & loLetzte) 'jede Zelle im Bereich durchlaufen For Each rg2 In rg1 zelle = rg2.Formula If Left(zelle, 1) <> "=" Then rg2.ClearContents End If Next rg2 'Formtierungen festlegen rg1.HorizontalAlignment = xlCenter rg1.Font.ColorIndex = 3 'nur Spalte N formatieren Set rg1 = ws.Range("N2:N" & loLetzte) rg1.FormulaLocal = "hier erfolgt ein berechnungsschritt" rg1.NumberFormat = "General" Set rg1 = Nothing Set rg2 = Nothing Set ws = Nothing ThisWorkbook.Worksheets("tabelle3").Activate 'Systemeinstellungen wieder einschalten Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub

hallo
mein problem ist
das die tabelle dynamisc ist un mal länger mal kürzer ist.
beim ablauf der rechnung dauert es extrem lange wenn die spalten n und o nicht vorher gelöscht sind.
das problem mit dem code


Sub Löscht_zelleninhalt()
Dim ZeileEnde, SpalteEnde, y, x, zelle
ZeileEnde = 10  'letzte Zeile = 10
SpalteEnde = 15  'letzte Spalte = o
For y = 14 To SpalteEnde 'Bereich ab Spalte n bis o
For x = 2 To ZeileEnde  'Bereich ab Zeile 1 bis hier müßte angepaßt sein
Cells(x, y).Select
zelle = ActiveCell.Formula
If Left(zelle, 1) <> "" Then Cells(x, y).ClearContents
Next x
Next y
End Sub

ist das ich zeileende=
vorgeben muß jedoch ist die zeilenanzahl ja immer anders.
und deshalb wollte ich diese in


Sub selo_berechnung2()
'10 ist ok
'berechnung der formel für die diagramme
Worksheets("gesamtplanung").Activate
With ActiveSheet
Dim loLetzte As Long
Dim loI As Long
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
For loI = 2 To loLetzte
Cells(loI, 15).FormulaLocal = "=g" & loI & "+1"
Cells(loI, 14).FormulaLocal = "=WENN(Arbeitstage!$J$7=WAHR;fünftage(c" & loI & ";d" & loI & ";Arbeitstage!Feiertage);(WENN(Arbeitstage!$K$7=WAHR;atc(c" & loI & ";d" & loI & ";Arbeitstage!Feiertageso);o" & loI & ")))"
Cells(loI, 14).NumberFormat = "General"
Range(Cells(loI, 14), Cells(loI, 15)).HorizontalAlignment = xlCenter
Next loI
Range(Cells(loI, 14), Cells(loI, 15)).Font.ColorIndex = 3
End With
'Worksheets("tabelle3").Activate
End 

Sub
einfügen da hier ja die schleife vorhanden ist.
gruß
selo

Beliebteste Forumthreads (12 Monate)

zelleninhalte löschen funktioniert nicht

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

zelleninhalte löschen funktioniert nicht

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread