Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

wenn-dann-fkt für nen ganz speziellen Fall





Frage

Hi Guys, kennt jemand vielleicht eine wenn-dann-fkt, die mir ermöglicht nur beschriebene Zellen zu kopieren? Also, das soll so aussehen: wenn in a1 Text steht, dann nach b1 kopieren, wenn nicht, dann soll a2 geprüft werden und, wenn Text drin steht, nach b1 kopiert werden. die Spalte a könnte ich dann ausblenden. Ich möchte auf diese Weise meine leeren Zellen ohne umständliche Makros los werden. Hab gesehen, dass sich hier der ein oder andere die Zähne daran ausgebissen hat. Best regards Quako

Antwort 1 von JoeKe

Hallo Quako,

da ich mal davon ausgehe, dass die Überprüfung ob in den Zellen der A - Spalte Text steht, über A1 und A2 hinausgeht, würde eine Funktionlösung zu umständlich, wenn, je nach Aufbau deiner Tabelle, nicht sogar unmöglich.
Habe dir mal ein umständliches Makro geschrieben.

Sub verschieben()
Dim arr() As String, i As Integer, intZeilen As Integer, ziel As Integer
ziel = Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
If ziel > 1 Then
ziel = 1
End If
intZeilen = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To intZeilen
If Cells(i, 1) <> "" Then
ReDim arr(intZeilen)
arr(i) = Cells(i, 1)
Cells(ziel, 2) = arr(i)
ziel = ziel + 1
End If
Next
End Sub

Bei bedarf kann das Ausblenden der Spalte A noch mit eingbaut werden.

MfG

JöKe

Antwort 2 von Quako

Hi JöKe,

vorab schon mal mein Danke schön für deine Hilfe, allerdings passiert da gar nix. Weder die Zellen mit, noch die Zellen ohne Inhalt fühlen sich genötigt den Weg in Spalte B anzutreten.

P.S.: Kann das Makro auch erst ab Zeile 250 anfangen?

Best regards
Quako

Antwort 3 von JoeKe

Hallo Quako,

die gefundenen Zellen werden ab B1 eingefügt egal wo die erste nicht leere Zelle ist. Wenn du erst ab Zeile 250 suchen und auch erst einfügen willst sieht das Makro so aus:

Sub verschieben()
Dim arr() As String, i As Integer, intZeilen As Integer, ziel As Integer
ziel = 250
intZeilen = Cells(Rows.Count, 1).End(xlUp).Row
For i = 250 To intZeilen
If Cells(i, 1) <> "" Then
ReDim arr(intZeilen)
arr(i) = Cells(i, 1)
Cells(ziel, 2) = arr(i)
ziel = ziel + 1
End If
Next
End Sub


MfG

JöKe

Antwort 4 von ExcelGast

Hi,
Du mußt das Makro anpassen, d.h. Spalten und Zeilen eingeben.
OK?
Hast Du das gemacht?
Und dann natürlich auch starten.

gruß

Antwort 5 von Quako

Super Sache, das klappt ganz hervorragend. Danke JöKe.

Sorry, dass ich mich erst jetzt melde, aber ich war im Urlaub.

Ein gesundes und erfolgreiches jahr 2006 wünsch ich jedenfalls und danke nochmal.

Best regards
Quako

Antwort 6 von JoeKe

Moin Quako,

auch dir ein erfolgreiches Jahr 2006.
Und vielen Dank für die Rückinfo.

JöKe

Antwort 7 von Quako

Hi JöKe,

jetzt muss ich schon wieder was fragen...sorry :-)

Aber gibt es auch die Möglichkeit, dass das Makro nicht erst von mir gestartet werden muss, sondern, dass es direkt die Veränderungen übernimmt. Also, wenn ich z.B. nachträglich Text in A255 einfüge, kann dann das Makro direkt reagieren und die entsprechende Zeile wieder aus der nach B kopierten Spalte entfernen?

Meinen herzlichsten Dank nochmal.

Best regards
Quako

Antwort 8 von JoeKe

Hallo Quako,

ja das geht. Dazu muß der Code als Worksheet_SelectionChange Ereignis in das VBA-Projekt des Tabellenblattes in dem er ausgeführt werden soll.
Um in das VBA-Projekt zu gelangen klickts du mit rechts auf das Blattregister und wählst dann "Code anzeigen". Dort fügst du folgenden Code ein:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim arr() As String, i As Integer, intZeilen As Integer, ziel As Integer
ziel = 250
intZeilen = Cells(Rows.Count, 1).End(xlUp).Row
For i = 250 To intZeilen
If Cells(i, 1) <> "" Then
ReDim arr(intZeilen)
arr(i) = Cells(i, 1)
Cells(ziel, 2) = arr(i)
ziel = ziel + 1
End If
Next
End Sub


Der Code wird nun bei jeder Änderung im Tabellenblatt ausgeführt.
Bei weiteren Frage meld dich ruhig nochmal.

MfG

JöKe

Antwort 9 von Quako

Hi JöKe,

du bist echt spitze. Danke für deine Hilfe. Allerdings werde ich aufgefordert einen Makronamen einzugeben, wenn ich dies versuche, ist er entweder ungültig oder es passiert nix.

Hab ich es vielleicht falsch eingefügt? Hab es in Tabelle2 (wo sich auch meine Auflistung befindet) eingefügt. Direkt nach meiner Option Explicit.

Oooohhhh, ich bin ja sooooo nervig......

Best regards
Quako

Antwort 10 von JoeKe

Hi Quako,

ich fürchte du hast es in das falsche VBA-Projekt eingefügt oder nicht vollständig kopiert.

rechts klick auf das Blattregister (Tabelle2) dann im Kontextmenue auf "Code anzeigen" und dort den obrigen Code komplett rein kopieren.

Probier es nochmal aus. Wenn du nicht zurecht kommst schick mir ma deine e-mail Addresse dann kann ich dir meine Mustermappe zuschicken.

MfG

JöKe

Antwort 11 von Quako

Hi JöKe,

soweit alles klar. Zur Hälfte klappt es auch. Problem ist jetzt nur, dass die alten Werte nicht gelöscht werden. Excel erkennt zwar, dass etwas geändert wurde, löscht aber die alten Werte nicht, sondern fügt sie unter den alten nochmals an.

Standen vorher nur a, b, c in der Liste, wird nach der Änderung unter a,b,c nochmals a,b,c,d angefügt.

Vielen Dank !!!

Best regards
Quako

Antwort 12 von JoeKe

Nabend Quako,

dann muss noch ein Befehl zum Löschen der Spalte B mit rein.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim arr() As String, i As Integer, intZeilen As Integer, ziel As Integer
ziel = 250
Range("B250:B65536").Clear
intZeilen = Cells(Rows.Count, 1).End(xlUp).Row
For i = 250 To intZeilen
If Cells(i, 1) <> "" Then
ReDim arr(intZeilen)
arr(i) = Cells(i, 1)
Cells(ziel, 2) = arr(i)
ziel = ziel + 1
End If
Next
End Sub

Mfg

JöKe

Antwort 13 von Quako

Hi JöKe,

mal wieder etwas spät, aber dennoch möchte ich deine Bemühungen nicht unkommentiert lassen.

Klappt nämlich ganz hervorragend. Tausend Dank. Hast mir RICHTIG geholfen.

Best regards
Quako

Antwort 14 von JoeKe

Moin Quako,

lieber spät als nie. :-)
Dank dir für die Rückmeldung.

MfG

JöKe

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: