Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1944to1948
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
Inhaltsverzeichnis

Suchen in einer Schleife

Suchen in einer Schleife
04.09.2023 14:51:31
cluemi
Hallo zusammen,
vor vielen Jahren habe ich auch schonmal ein bisschen vba aufgezeichnet und nachbearbeitet. Nur soviel zu meinem Kenntnissstand.

Aktuell habe ich in einer Benutzertabelle in der zweiten und dritten Spalte mehrere Informationen untereinander. Um bessere Filtermöglichkeiten zu haben, möchte ich diese Infos trennen. Dazu dupliziere ich die Spalte "B".
Ich suche in der Spalte B nach Mail-Adressen also "@". Bei einem Treffer lösche ich den Inhalt der Zelle in Spalte B und schiebe die "Kopie" in Spalte C eine Zeile nach oben.
Dann gehe ich wieder zurück auf die Spalte "B" und möchte die Spalte weiter durchsuchen, um den nächsten Treffer zu behandeln.
Das ganze passiert in einer Schleife bis zum Spaltenende.
Soweit der Plan. Jetzt der Code:
    Columns("B:B").EntireColumn.Select

Selection.Copy
Columns("C:C").EntireColumn.Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False


Dim objCell As Range
Dim FirstRow As Long
Range("B1").Select

With ThisWorkbook.Worksheets(1)
Set objCell = .Cells.Find(What:="@", lookIn:=xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByColumns)

If Not objCell Is Nothing Then
FirstRow = objCell.Row
Do
'objCell.Activate
Selection.ClearContents
ActiveCell.Offset(0, 1).Select
Selection.Cut
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Select

Set objCell = .FindNext
Loop Until objCell.Row FirstRow
Set objCell = Nothing
End If
End With

Der erste Durchlauf gelingt perfekt. Beim Aufruf von ".FindNext" bekomme ich aber einen
Laufzeitfehler '438': Objekt unterstützt diese Eigenschaft oder Methode nicht.

Die Schleife hatte ich irgendwo abgekupfert und verstehe nicht, warum sie bei mir nicht mehr tut.
Meine Recherchen zu "find" und "Schleifen" gaben jede Menge Ideen, die aber nicht zu meinem Thema gepasst haben.

Vielen Dank für jegliche Unterstützung :)
Gruss, cluemi

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen in einer Schleife
04.09.2023 15:34:44
onur
Set objCell = .FindNext(objCell)
Suchen in einer Schleife
04.09.2023 16:14:59
cluemi
Vielen Dank onur!
Ich wollte meine letzten Tests eigentlich noch aus dem Code herausnehmen. Leider vergessen.
objCell.Activate
sollte nicht kommentiert sein und
Set objCell = .FindNext(objCell)
braucht das "(objCell)".
Am Ergebnis bzw. der Fehlermeldung ändert sich damit aber nichts!
AW: Suchen in einer Schleife
04.09.2023 16:27:44
onur
Du weisst aber schon, dass dein Makro auf dem ganzen Blatt nach "@" sucht - oder ? Warum ?
Wieso nicht einfach SO:
    Dim z

For z = 1 To 1000
If InStr(Cells(z, 2), "@") > 0 Then
'Hier der Code für was immer geschehen soll, wenn @ gefunden
End If
Next z
Anzeige
Suchen in einer Schleife
06.09.2023 10:18:17
cluemi
Auch sowas hatte ich schon ins Auge gefasst,
vielen Dank Onur.
Sicher wollte ich nicht die ganze Tabelle durchsuchen. Ich hatte, nachdem das find mit columns eine Ffehlermeldung geworfen hat, mal auf cells umgestellt.
Dein Schleifchen bekommt von mir ein Schleifchen und wird in meiner Snippet-Sammlung festgehalten :)
Suchen in einer Schleife
04.09.2023 15:53:14
snb
Mehrfach Suchen = Filtern.

Benütze autofilter.
Suchen in einer Schleife
04.09.2023 16:06:17
GerdL
Hallo Cluemi!
Sub Unit()


Dim objCell As Range, Rng As Range, Firstaddress As String

With ThisWorkbook.Worksheets(1)
Set objCell = .Columns(2).Find(What:="@", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows)
If Not objCell Is Nothing Then
Firstaddress = objCell.Address
Set Rng = objCell
Do
Set Rng = Union(Rng, objCell)
Set objCell = .Columns(2).FindNext(objCell)
Loop Until objCell.Address = Firstaddress
Set objCell = Nothing
End If
.Columns(3).EntireColumn.Insert Shift:=xlToRight
If Not Rng Is Nothing Then
Rng.Copy .Cells(2, 3)
Set Rng = Nothing
End If
End With

End Sub

Gruß Gerd
Anzeige
Suchen in einer Schleife
04.09.2023 18:34:26
cluemi
Hi GerdL,
dein Code kommt meinen Wünschen/meinem Ansatz schon recht nahe.
So sieht er jetzt aus:
    Columns("B:B").EntireColumn.Select

Selection.Copy
Columns("C:C").EntireColumn.Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False

Dim objCell As Range, Rng As Range, FirstRow As Integer

With ThisWorkbook.Worksheets(1)
Set objCell = .Columns(2).Find(What:="@", lookIn:=xlValues, LookAt:=xlPart)
If Not objCell Is Nothing Then
FirstRow = objCell.Row
Do
objCell.Activate
Selection.ClearContents
ActiveCell.Offset(0, 1).Select
Selection.Cut
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Select

Set objCell = .Columns("B:C").FindNext(objCell)
Loop Until objCell.Row = FirstRow
Set objCell = Nothing
End If

End With

Die Schleife funktioniert, nur die Abbruchbedingung ist noch nicht wirklich schön: wenn der erste Wert in der zweiten Spalte (C) gefunden wird.
Loop Until objCell = Nothing funktioniert nicht.
In der Antwort von Yal habe ich gerade "entpivotieren" gelesen. Ja, das trifft's sehr gut!
Ich wollte ein Bildchen anzuhängen, um die Struktur der Daten deutlicher zu machen, aber ich kann weder Bild noch Excel Daten anhängen...
Gruss, Clemens
Anzeige
Suchen in einer Schleife
04.09.2023 17:29:55
Yal
Hallo Cluemi,

komplett unabhängig von den guten Antworten der geschätzten Kollegen, es scheint eine Entpivotierungsaufgabe zu sein.
Also aus (als Zellinhalt zu verstehen)
A1;B1
A1;B2
A1;B3
A4;B4
A4;B5
A4;B6
A7;B7

willst Du
A1;B1;B2;B3
A4;B4;B5;B6
A7;B7

haben, richtig? (Voraussetzung ist dass die Werte In Spalte A sich je 3-mal wiederholen)

Mache dann aus deinen Datenbereich eine Tabelle: Menü "Einfügen", "Tabelle"
dann mit Menü "Daten", "aus Tabelle" (die markierte Zelle muss gerade in der Tabelle sein) steigst Du in Power Query ein.
Markiere dort die zweite Spalte und gehe auf "Transformieren", "entpivotieren".
"Datei", "Schliessen und laden"

Das Thema filtern der Zellen mit "@" ist auch nur ein paar klick entfernt.
Erste Schritt und mehr unter https://excelhero.de/power-query/power-query-ganz-einfach-erklaert

VG
Yal
Anzeige
Suchen in einer Schleife
06.09.2023 10:35:52
cluemi
Auch an Yal noch vielen Dank! Ja, so ähnlich sehen meine Daten aus. Die Anzahl der Zeilen pro User kann aber unterschiedlich sein.
An die PowerQuery möchte ich mich aufgrund des fortgeschrittenen Alters nicht mehr heranwagen -- obwohl es mich schon reizt ;)
Na vielleicht, wenn ich in Rente bin, da hat man ja bekanntlich viiiiiel Zeit...

Aber was ich noch so ganz allgemein loswerden/fragen will:
ich habe ein paar Beispieldaten generiert, um mein Problem besser darstellen zu können. Einen Screenshot oder ein xlsx konnte ich nicht hochladen, da die Vorgabe-Dateitypen das beim Upload nicht anbieten. Erst jetzt habe ich kapiert, das ich dort auch auf "Alle Dateien" erweitern kann. Ich dachte, die Vorgabe sei absolut. Vielleicht lässt sich das in den FAQ noch ein bisschen besser beschreiben.

Vielen Dank nochmal an alle, die mich unterstützt haben!
Clemens
Anzeige
Suchen in einer Schleife
06.09.2023 14:26:07
Yal
Hallo Clemens,

die Frage ist nicht so sehr, ob Du eine Werkzeug bis ins letzter Details beehrschen möchtest, oder die g'scheite Methode, um schnell ein tägliches Problem loszuwerden. Du kennst vielleicht nur 5% von VBA, verwendest es aber trotzdem.

Das Begriff "entpivotieren" habe ich nicht umsonst platziert: es ist DIE Funktion, wegendessen man einen Blick ins Power Query (PQ) werfen sollte. Ich habe jahrelang unzählige VBA-Makro geschrieben, bevor ich entdeckte, dass PQ dasselbe in ein paar Klick zuverlässiger erledigt.

Natürlich, man erledigt zuerst den Soll, aber was man auf dem Weg sieht, macht einem neugirieg. Ein paar Try & Error weiter bist Du schon PQ-Fan: bevor Alt-F11 (VBA-Editor ;-) gedruckt wird, immer die Frage, kann man das nicht mit PQ lösen?

Wirf ein Auge auf dem Link von Excel-hero/Daniel Kogan: 6 Videos, insg. 40 Min (die 7te, 20 Min, ist optional). Es ist eine sehr gute Zeit-Investition.
Hier nochmal https://excelhero.de/power-query/power-query-ganz-einfach-erklaert

VG
Yal
Anzeige
Suchen in einer Schleife
06.09.2023 15:07:54
daniel
Hi
die Aufgabenstellung von Yal kann man auch von Hand einfach lösen:

1. in die Spalte C kommt von C1 bis Datenende die Formel:: =B1&Wenn(A1=A2;";";C2)
2. dann die Spalte Kopieren und als Wert einfügen
3. mit allen drei Spalten Daten - Datentools - Duplikate Entfernen ausführen (mit Spalte A als Kriterium)
4. mit Spalte C Daten - Datentools - Text in Spalten ausführen mit dem Semikolon als Trennzeichen
5. Spalte B löschen

Das geht auch einfach als Code, bei der Erstellung der komplizierteren Sachen (Formel schreiben, Duplikate entfernen, Text in Spalten) kann man sich vom Recorder helfen lassen.

Sub test()

With Range("C1:C" & Cells(1, 1).End(xlDown).Row)
.FormulaR1C1 = "=RC2&IF(RC1=R[1]C1,"";""&R[1]C,"""")"
.Formula = .Value
.EntireRow.RemoveDuplicates 1, xlNo
.TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False
End With
Columns(2).Delete
End Sub


Gruß Daniel
Anzeige
Suchen in einer Schleife
06.09.2023 14:50:02
cluemi
Danke Yal,
wenn du PQ so hoch lobst, dann muss ich mir doch mal am Wochenende eine Stunde Zeit dafür nehmen und wenigstens ein bisschen schnuppern...
VG, Clemens
Suchen in einer Schleife
05.09.2023 09:35:18
cluemi
Hallo Gerd,

vielen Dank für den Link. Eine nett gemachte Geschichte, um mir und anderen "Anfängern" das Thema zu verdeutlichen.
Ich habe auch immer wieder code reduziert, z.B. um im "find" nicht alle Attribute (oder Parameter?) mitzuführen.
Jetzt habe ich mir den Block vorgenommen:
objCell.Activate

Selection.ClearContents
ActiveCell.Offset(0, 1).Select
Selection.Cut
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(0, -1).Select

und habe
objCell.ClearContents

objCell.Offset(0, 1).Cut
objCell.Offset(-1, 0).Paste
objCell.Offset(0, -1).Select

Das letzte select, denke ich, brauche ich, um für das FindNext den richtigen Ausgangspunkt zu haben.
Aber schon beim cut kommt eine Fehlermeldung, die für den oben erwähnten Dummie nicht hilfreich ist.
Zuhause hätte ich mir evtl. bei einem solchen Thema noch 2 Stunden "gegönnt". Aber bei der Arbeit sehe ich schon den Chef, der fragt, warum ein paar Zeilen Code so viel Zeit benötigen ;)
Trotzdem danke ich Dir, ein bisschen über den Tellerrand schauen und etwas mitnehmen ist immer gut!
Gruss, Clemens
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige