Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
908to912
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
908to912
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Tabelle ausdünnen

Tabelle ausdünnen
23.09.2007 14:42:00
Mat
Hallo Leute,
ich möchte Arbeitszeiten von Excel nach Outlook übergeben. Leider verhindern einige Zellinhalte (Formeln/Nullwerte) das korrekte Übernehmen der Anfangs- u. Endzeiten im Outlook.
Ich habe mir nun gedacht, die Tabelle mit einem Zwischenschritt für die Übergabe vorzubereiten. Es sollen hierbei nur die Zeilen erhalten bleiben, in welchen ein Wert in Spalte B steht. Ferner müssen alle Formelergebnisse welche Nullwerte in den Spalten c bis g ergeben gelöscht werden.
Anbei ein Bsp. wie das Ergebnis aussehen sollte: https://www.herber.de/bbs/user/46277.xls
Vielen Dank für jede Hilfe!
Beste Grüße
Mat

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle ausdünnen
23.09.2007 15:43:00
Mat
Hallo Sepp,
ich würde das Ganze lieber mit einem Macro erledigen. Ich habe mir eins zusammen gebastelt. Es funktioniert, läuft aber meiner Meinung nach etwas langsam:

Sub DeleteRowIfEmptyCell()
Dim intRow As Integer, intLastRow As Integer
intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For intRow = intLastRow To 1 Step -1
If Application.CountA(Rows(intRow)) = 0 Then
intLastRow = intLastRow - 1
Else
Exit For
End If
Next intRow
For intRow = intLastRow To 1 Step -1
If IsEmpty(Cells(intRow, 2)) Then
Rows(intRow).Delete
End If
Next intRow
Call LeereZellenWennNull
End Sub



Sub LeereZellenWennNull()
Dim rngC As Range
For Each rngC In Range("A2:g34")
If rngC.Value = 0 Then
rngC.FormulaR1C1 = ""
rngC = ""
End If
Next rngC
End Sub


Vielleicht weiß jemand noch eine Verbesserung.
Beste Grüße
Mat

Anzeige
AW: Tabelle ausdünnen
23.09.2007 15:54:35
Josef
Hallo Mat,
was spricht gegen den Spezialfilter per Makro?
Diene Tabelle muss Überschriften haben und zwar bei allen Spalten.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub ADVFilter()

Sheets("Tabelle1").Range("A1").CurrentRegion.Clear 'Tabellenname für Zieltabelle anpassen

With Sheets("Org") 'Tabellenname für Ausgangstabelle anpassen
    .Range("J2").Formula = "=B2<>"""""
    
    .Range("A1").CurrentRegion.AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Org").Range("I1:J2"), _
        CopyToRange:=Sheets("Tabelle1").Range("A1"), _
        Unique:=False
    
    .Range("J2").Clear
End With

End Sub

Gruß Sepp

Anzeige
AW: Tabelle ausdünnen
23.09.2007 16:56:00
Josef
Hallo Mat,
dann mach es so.
Sub Ausduennen()
Dim rng As Range, rngU As Range

On Error GoTo ErrExit
GMS

With Sheets("Org") 'Tabellenname anpassen
    
    For Each rng In .Range("B2:B" & .Cells(Rows.Count, 1).End(xlUp).Row)
        If rng = "" Then
            If rngU Is Nothing Then
                Set rngU = rng.EntireRow
            Else
                Set rngU = Union(rngU, rng.EntireRow)
            End If
        End If
    Next
    
    If Not rngU Is Nothing Then rngU.Delete
    
    For Each rng In .Range("C2:G" & .Cells(Rows.Count, 1).End(xlUp).Row)
        If rng.HasFormula And rng.Value = 0 Then rng.ClearContents
    Next
    
End With

ErrExit:
GMS True
Set rng = Nothing
Set rngU = Nothing
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = lngCalc
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub


Gruß Sepp

Anzeige
AW: Tabelle ausdünnen
24.09.2007 12:49:00
Mat
Hallo Sepp,
funktioniert einwandfrei!!! Super besten Dank!!
Gruß Mat

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige