Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon felixso vom 07.04.2022, 15:21 Options

Fehler im Makro zum bedingten kopieren von Zellen

Hallo zusammen,

ich habe mal wieder ein Problem mit Excel, das ich versucht habe zu lösen. Leider ist mir dies aufgrund meiner geringen VBA Kenntnisse nicht gelungen.
Es handelt sich um folgendes Problem:
Mittels eines Makros sollen die Zellwerte von A1:A340 einer Tabelle (hier Tabelle 26) kopiert und in eine bestehende Tabelle (Tabelle 23) kopiert werden.
Soweit funktioniert es.
Alle Zellen des zu kopierenden Bereichs enthalten Formeln (WENN DANN Funktionen hauptsächlich). Bei einigen Zellen ist das Formelergebnis nichts (""), so dass eine leere Zelle vorhanden ist.
Diese "leeren" Zellen sollen nicht mitkopiert werden, bzw. beim kopieren gelöscht werden, so dass in der Tabelle 23 eine Liste ohne die leeren "Formelzellen" erscheint.
Dazu habe ich mir das folgende Makro gebastelt:


Sub TaballeohneLeerekopieren()
On Error Resume Next
Dim i As Integer
ThisWorkbook.Worksheets("Tabelle26").Activate
Sheets("Tabelle26").Range("A1:A344").Copy Destination:=Sheets("Tabelle21").Range("A1")



Application.ScreenUpdating = False
Sheets("Tabelle21").Activate
Range("A1:A344").Select
For i = Selection.Cells(Selection.Cells.Count).Row _
To Selection.Cells(1).Row Step -1
If Cells(i, "A").Value = IsEmpty(Cells(i, "A").Value) Then Rows(i).EntireRow.Delete = True
Next i
Application.ScreenUpdating = True
    If Cells(i, "A").Value = IsEmpty(Cells(i, "A").Value) Then Rows(i).EntireRow.Delete = True

End Sub

Das Problem bei diesem Makro:

Es werden sowohl die "leeren Formelzellen" in der ursprünglichen Tabelle (Tabelle 26) und in der neuen Tabelle (Tabelle 21) gelöscht.

Meine Frage deshalb:
Wie muss ich das o. g. Makro "anpassen", damit nur in der neuen Tabelle (Tabelle 21) die leeren Formelzellen gelöscht werden und die Ursprungstabelle (Tabelle 26) mit den "leeren Formelzellen" erhalten bleibt?

Vielen Dank!

Felix

Antwort schreiben

Antwort 1 von rainberg vom 08.04.2022, 16:03 Options

Hallo Felix,

probier's mal so

Option Explicit

Sub TaballeohneLeerekopieren()
    Dim arr(0 To 343, 0), rngC As Range, intZ As Integer
    For Each rngC In Worksheets("Tabelle26").Range("A1:A344")
        If rngC.Value <> "" Then
            arr(intZ, 0) = rngC.Value
            intZ = intZ + 1
        End If
    Next
    Worksheets("Tabelle21").Range("A1:A" & intZ) = arr()
End Sub

Gruss
Rainer

Antwort 2 von felixso vom 09.04.2022, 10:53 Options

Hallo Rainer,

vielen Dank für das Makro!
Es funktioniert so wie ich es mir vorgestellt habe.
Alleine hätte ich das nicht geschafft.
Nun würde ich gerne noch drei Ergänzungen des Makros vornehmen:

- Bevor die Tabelle 26 kopiert wird, sollen die Zellen der Tabelle 21 leer sein (sofern man das Makro vorher schon ausgeführt hat und Änderungen in der Tabelle 26 vorgenommen hat, führt dies dazu, dass weniger Zellen kopiert werden müssen. Das Problem ist dann, dass die "alten" befüllten Zellen stehen bleiben).

- Es sollen auch die Zellenformate der einzelnen Zellen der Tabelle 26 mitkopiert werden.

- Bei Ausführung des Makros soll automatisch die Tabelle 21 ausgewählt werden.

Mein Lösungsvorschlag funktioniert leider nicht. Es wird die Tabelle 21 gelöscht und die Formatierungen der einzelnen Zellen nicht übernommen.
Hier der von Dir übernommene Code mit meinen Änderungen:


Sub TaballeohneLeerekopieren()
ThisWorkbook.Worksheets("Tabelle21").Activate
Range("A1:A340").Clear

    Dim arr(0 To 340, 0), rngC As Range, intZ As Integer
    For Each rngC In Worksheets("Tabelle26").Range("A1:A340")
        If rngC.Value <> "" Then
            arr(intZ, 0) = rngC.Value And rngC.FormatConditions
        
            intZ = intZ + 1
        End If
    Next
    Worksheets("Tabelle21").Range("A1:A" & intZ) = arr()
    Sheets("Tabelle21").Select
    Range("A1").Select
End Sub

Für Lösungsvorschläge wäre ich sehr dankbar!

Gruß
Felix

Antwort 3 von rainberg vom 09.04.2022, 11:58 Options

Hallo Felix,

warum hast Du die Formate nicht gleich erwähnt?

So funktioniert es bei mir.

Option Explicit

Sub TaballeohneLeerekopieren()
    Dim rngC As Range
    Application.ScreenUpdating = False
    For Each rngC In Worksheets("Tabelle26").Range("A1:A340")
        If rngC.Value <> "" Then
            With Worksheets("Tabelle21").Range("A" & Worksheets("Tabelle21").Cells(Rows.Count, 1).End(xlUp).Row + 1)
                .Value = rngC.Value
                .Font.ColorIndex = rngC.Font.ColorIndex
                .Font.Bold = True = rngC.Font.Bold
                .Interior.ColorIndex = rngC.Interior.ColorIndex
                'hier kannst Du weitere Formate eintragen
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Gruss
Rainer

Antwort 4 von felixso vom 09.04.2022, 12:22 Options

Hallo Rainer,

vielen vielen Dank für die schnelle Hilfe!
Leider funktioniert das neue Makro bei mir nicht.
Es erscheint beim Debuggen in der Codezeile:


If rngC.Value <> "" Then

Die Fehlermeldung "Laufzeitfehler 13 Typen unverträglich".
Ich arbeite hier mit Excel 2003.
Könntest Du mir erklären, was ich falsch mache?
Noch einmal vielen Dank!

Gruß

Felix

Antwort 5 von rainberg vom 09.04.2022, 12:39 Options

Hallo Felix,

kann die Fehlermeldung nicht nach vollziehen.
Bei mir läuft der Code sowohl unter Excel 2007 als auch unter Excel 2003.

Lade doch Deine Datei mal hoch.

Gruss
Rainer

Antwort 6 von felixso vom 09.04.2022, 14:42 Options

Hallo Rainer,

der Fehler lag nicht am Makro sondern in meinen Formeln.
Das Makro funktioniert gut!
Vielen Dank!
Nun hätte ich noch eine letzte Frage:
Bei Ausführung des Makros wird der in der Tabelle 3 (der Beispieldatei) bereits stehende Text immer weiter nach unten verschoben.

Wie kriege ich es hin, dass in der Tabelle 3 nur der Text steht, der bei Ausführung des Makros entsteht?
Also bereits in Tabelle 3 stehender Text soll gelöscht werden.

Ich dachte, dass man am Anfang des Makros schreibt, dass die Spalte A der Tabelle 3 gelöscht wird und dann erst das Makro ausgeführt wird...

Eine Beispieldatei mit der Darstellung des "Problems" habe ich hier hochgeladen:
http://www.file-upload.net/download-2421277/Zusammenfassung.xls.html

Vielen Dank für die Hilfe und Geduld!

Gruss
Felix

Antwort 7 von rainberg vom 09.04.2022, 16:11 OptionsLösung

Hallo Felix,

hier die Änderung

Option Explicit

Sub TaballeohneLeerekopieren()
    Dim rngC As Range
    Application.ScreenUpdating = False
    Worksheets("Tabelle3").Range("A:A").Delete
    For Each rngC In Worksheets("Tabelle2").Range("A2:A5")
        If rngC.Value <> "" Then
            With Worksheets("Tabelle3").Range("A" & Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row + 1)
                .Value = rngC.Value
                .Font.ColorIndex = rngC.Font.ColorIndex
                .Font.Bold = True = rngC.Font.Bold
                .Interior.ColorIndex = rngC.Interior.ColorIndex
                'hier kannst Du weitere Formate eintragen
            End With
        End If
    Next
    Sheets("Tabelle3").Select
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub

Anstatt
Worksheets("Tabelle3").Range("A:A").Delete
kannst Du auch
Worksheets("Tabelle3").Range("A:A").ClearContents
verwenden, aber dann müsstest Du auch die Formate zurück setzen.
Ich denke aber Delete richtet in diesem Falle keinen Schaden an und ist einfacher.

Gruss
Rainer

Antwort 8 von felixso vom 12.04.2022, 09:27 Options

Hallo Rainer,

noch einmal vielen Dank für die Hilfe!
Jetzt funktioniert alles so wie es sein soll.

Viele Grüße

Felix

Antwort 9 von Beverly vom 12.04.2022, 10:07 Options

Hi,

nur als Hinweis: mit der Zeile

Worksheets("Tabelle3").Range("A:A").Delete

wird die gesamte Spalte gelöscht , also physisch entfernt. Dieser Effekt spielt zwar hier keine Rolle, ist aber in dem Fall von ausschlaggebender Bedeutung, wenn auch Daten in Spalte B usw. stehen würden, denn das bedeutet, dass alle Spalten rechts von Spalte A nach links nachrücken (ganz einfach zu testen, wenn man mal etwas in Spalte B einträgt).

Zum Leeren von Zellen (Inhalte und Formate) verwendet man besser diesen Code:

Worksheets("Tabelle3").Range("A:A").Clear

denn die Spalte bleibt dabei physisch erhalten.

Bis später,
Karin

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..