Suchen/Markieren/Verschieben

Informationen und Beispiele zu den hier genannten Dialog-Elementen:


Excel-Version: 9.0 (Office 2000)
nach unten

Betrifft: Suchen/Markieren/Verschieben
von: Patrizia
Geschrieben am: 17.07.2002 - 11:30:48

Hallo !!!

Ich hoffe mir kann jemand bei meinem folgenden Problem helfen:

Ich möchte in einer Tabelle nach einem bestimmten Wert suchen.
Wenn dieser Wert gefunden wird die komplette Zeile in der der Wert enthalten ist ausschneiden und in eine ander Tabelle verschieben.

Mein Code:

Sub ArtikelSuchenKopieren()
'Sucht einen Begriff in einem bestimmten Blatt,
'und kopiert die Ergebnisse in ein anderes Blatt

Static Suchbegriff As String
Dim Zelle, ErsteAdresse, ArbeitsblattDaten, ArbeitsblattErgebnis As String
Dim LetzteZelle, intCount As Integer
Application.ScreenUpdating = False

ArbeitsblattDaten = "00 - 19 VDS 00-19" 'Tabelle, in der gesucht wird
ArbeitsblattErgebnis = "test" 'Tabelle, in der die Ergebnisse stehen

Sheets(ArbeitsblattErgebnis).Cells.Clear 'Alte Tabelleninhalte löschen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", Default:=Suchbegriff)
If Suchbegriff = "" Then Exit Sub

Sheets(ArbeitsblattDaten).Activate
Rows(1).Copy 'Überschriftenzeile kopieren ...
Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
ActiveSheet.Paste '... und in dem anderen Tabellenblatt einfügen

Sheets(ArbeitsblattDaten).Activate
With ActiveSheet.UsedRange
Set Zelle = .Find(Suchbegriff, LookIn:=xlValues)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
Do
LetzteZelle = Sheets(ArbeitsblattErgebnis).Cells(Cells.Rows.Count, 1).End(xlUp).Row
Rows(Zelle.Row).Copy

Sheets(ArbeitsblattErgebnis).Select
Cells(LetzteZelle + 1, 1).Select
ActiveSheet.Paste
Sheets(ArbeitsblattDaten).Activate
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ErsteAdresse
End If

Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
End With

Application.CutCopyMode = xlCopy
Application.ScreenUpdating = True

End Sub

Habe diesen Code hier im Board gefunden und für meine Zwecke abgewandelt.

Habe jetzt folgendes Problem mit meinem Code:
1. Er kopiert nur die gefunden Zeilen aus der 1. Tabelle in die
2. Tabelle und schneidet diese nicht aus. Wenn möglich sollte
die Zeile ausgeschnitten werden die leere Zeile gelöscht und
ins 2. Tabellenblatt eingetragen werden.
2. Wenn die gefunden Zeilen nun im 2. Tabellenblatt eingefügt
werden werden immer die alten Einträge überschrieben. Dies
soll ab nicht so sein. Sollte in der 2. Tabelle bereits was
eingefügt sein sollen die gefunden Zeilen unten drunter ange-
fügt werden und nicht die bestehenden überschreiben.

Wäre ganz toll wenn mir jemand helfen könnte.
Für eure Hilfe bedanke ich mich bereits im voraus.

Patrizia


nach oben   nach unten

Re: Suchen/Markieren/Verschieben
von: Udo
Geschrieben am: 17.07.2002 - 12:51:49

Hallo Patrizia,
1.nach
Rows(Zelle.Row).Copy
Rows(Zelle.Row).EntireRow.Delete

2.nach
ActiveSheet.Paste
LetzteZelle=LetzteZelle+1

Dann sollte es klappen

Gruss Udo


nach oben   nach unten

Re: Suchen/Markieren/Verschieben
von: Patrizia
Geschrieben am: 17.07.2002 - 13:09:23

Hallo Udo,

danke erstmal für deine Hilfe.
Leider funktioniert es nicht bei mir.
Bringt mir einen Fehler.
Wo genau in meinem Code muß ich deine zeilen einfügen ???

Patrizia


nach oben   nach unten

Re: Suchen/Markieren/Verschieben
von: Udo
Geschrieben am: 18.07.2002 - 12:56:14

Hallo Patrizia,
1.hinter der Zeile
Rows(Zelle.Row).Copy
die Zeile
Rows(Zelle.Row).EntireRow.Delete
einfügen
2.hinter die Zeile
ActiveSheet.Paste
die Zeile
LetzteZelle=LetzteZelle+1
einfügen.
Dann sollte es klappen.

Gruss Udo


nach oben   nach unten

Re: Suchen/Markieren/Verschieben
von: Patrizia
Geschrieben am: 18.07.2002 - 13:51:42

Hallo Udo,

habe meinen Code jetzt folgendermaßen geändert:Sub ArtikelSuchenKopieren()
'Sucht einen Begriff in einem bestimmten Blatt,
'und kopiert die Ergebnisse in ein anderes Blatt

Static Suchbegriff As String
Dim Zelle, ErsteAdresse, ArbeitsblattDaten, ArbeitsblattErgebnis As String
Dim LetzteZelle, intCount As Integer
Application.ScreenUpdating = False

ArbeitsblattDaten = "00 - 19 VDS 00-19" 'Tabelle, in der gesucht wird
ArbeitsblattErgebnis = "test" 'Tabelle, in der die Ergebnisse stehen

Sheets(ArbeitsblattErgebnis).Cells.Clear 'Alte Tabelleninhalte löschen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", Default:=Suchbegriff)
If Suchbegriff = "" Then Exit Sub

Sheets(ArbeitsblattDaten).Activate
Rows(Zelle.Row).Copy 'Überschriftenzeile kopieren ...
Rows(Zelle.Row).EntireRow.Delete
Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
ActiveSheet.Paste '... und in dem anderen Tabellenblatt einfügen
LetzteZelle = LetzteZelle + 1

Sheets(ArbeitsblattDaten).Activate
With ActiveSheet.UsedRange
Set Zelle = .Find(Suchbegriff, LookIn:=xlValues)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
Do
LetzteZelle = Sheets(ArbeitsblattErgebnis).Cells(Cells.Rows.Count, 1).End(xlUp).Row
Rows(Zelle.Row).Copy

Sheets(ArbeitsblattErgebnis).Select
Cells(LetzteZelle + 1, 1).Select
ActiveSheet.Paste
Sheets(ArbeitsblattDaten).Activate
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ErsteAdresse
End If

Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
End With

Application.CutCopyMode = xlCopy
Application.ScreenUpdating = True

End Sub


Funktioniert aber leider nicht bringt mir immer eine Fehlermeldung - erst Objekt erforderlich und markiert die Zeile
die ich neu eingefügt habe (deine Zeile zu 1.) und dann schreibt er noch Paste-Methode .... nicht möglich.

So ein Sch......
Bin am verzweifeln.
Ich hoffe du kannst mir noch helfen wäre dir sehr dankbar
dafür.

Patrizia

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Pivot-Tabelle mit Formel"