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
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
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
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ß
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
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
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
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
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
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
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
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
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
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
lieber spät als nie. :-)
Dank dir für die Rückmeldung.
MfG
JöKe