Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
716to720
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
716to720
716to720
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Ausdrücke finden, danebenstehende Zellen kopieren

Ausdrücke finden, danebenstehende Zellen kopieren
09.01.2006 03:17:27
Max
Ich versuche schon den ganzen tag dieses problem in VBA zu lösen, ich hoffe hier kann mir jemand helfen.
Folgendes:
Spalte A soll komplett nach dem immer gleichen Ausdruck "XYZ" durchsucht werden. Sobald der Ausdruck gefunden wurde, soll der Wert der 2 spalten weiter rechts in der gleichen zeile steht kopiert werden und eine Zeile höher und eine Spalte rechts davon eingetragen werden.
Nun soll anschliessend noch die komplette Zeile mit dem Suchbegriff gelöscht werden und die Suche weitergehen bis alle Zeilen mit dem Suchbegriff ausgemerzt sind. Ich weiss das klingt kompliziert, darum hier ein Beispiel:
1. In Zelle A3 wurde der Ausdruck "XYZ" gefunden.
2. jetzt auf C3 springen, diesen wert kopieren und in D2 einfügen
3. jetzt die komplette Zeile 3 löschen.
4. Wenn der Suchbegriff erneut gefunden wird, wiederholt sich das Spielchen
Ich hoffe es ist verständlich was ich beabsichtige ;)

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ausdrücke finden, danebenstehende Zellen kopieren
09.01.2006 04:15:45
chris
Hallo Hoffe das Hilft Dir weiter.

Sub neu()
Dim killrow()
was = InputBox("Suchbegriff", "")
Set cb = Worksheets(1).Range("a1:a500").Find(was)
If cb = NotNothing Then
Else
'Wurde gefunden
firstAddress = cb.Address
Do
Cells(cb.Row - 1, 2) = Cells(cb.Row, 3)
x = x + 1
ReDim Preserve killrow(x)
killrow(x) = (cb.Row)
Set cb = Worksheets(1).Range("a1:a500").FindNext(cb)
Loop While Not cb Is Nothing And cb.Address <> firstAddress
End If
For xx = UBound(killrow) To 1 Step -1
Rows(killrow(xx)).Delete
Next
End Sub

AW: Ausdrücke finden, danebenstehende Zellen kopie
09.01.2006 05:41:13
Ramses
Hallo
müsste
If cb = NotNothing Then
nicht
If Not cb is Nothing Then
heissen ;-) ?
Gruss Rainer
Anzeige
AW: Ausdrücke finden, danebenstehende Zellen kopieren
09.01.2006 06:02:00
Max
hmm
das klappt so bei mir nicht so recht
nach dem Eingeben des Suchbegriffes kommt:
"Laufzeitfehler '91': Objektvariable oder With-Blockvariable nicht festgelegt"
der Debugger verweist auf die Stelle "If cb = NotNothing Then" :(
AW: Ausdrücke finden, danebenstehende Zellen kopieren
09.01.2006 09:31:51
Max
ich habe eine Formel gefunden womit man schonmal die ganze zeile des suchbegriffs markieren und später auch löschen könnte, doch zuvor müssen ja noch die kopieroperationen durchgeführt werden, hat noch jemand eine idee?
die suche soll auch bei einem unvollständigem suchbegriff anschlagen!
wiegesagt suche ich immer nur nach den letzten 5 zeichen des strings der in spalte A steht!

Sub Suchen()
Dim rng As Range
Dim sFind As String
sFind = InputBox( _
prompt:="Suchbegriff:", _
Default:="XYZ")
If sFind = "" Then Exit Sub
Set rng = Columns(1).Find( _
what:=sFind, lookat:=xlWhole, LookIn:=xlValues)
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden!"
Exit Sub
End If
Rows(rng.Row).Select
End Sub

Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige