Office: Nach vorgegebenen Werten durchsuchen

Hallo, ich möchte auf dem Tabellenblatt "Daten" die ganze Spalte A bis zum letzten Wert, nach mehreren Zahlenkombinationen durchsuchen, die Zahlenkombinationen stehen auf dem Tabellenblatt "Nummer" in A2-A10.

Eigentlich kein großes Problem, ich habe mir mehrere Vorschläge hier aus dem Forum zusammengebastelt, mit einfärben usw., das klappt auch.

Das Problem und da komm ich nicht weiter, ich will nicht die gesuchten Zahlenkombinationen eingefärbt oder besser gesucht und kopiert haben, sondern alle die, die nicht zu den Kombinationen gehören.

Die Zahlen haben immer folgendes Format:

0944 5675134856
0944 5623931734
usw.


Gesucht wird nach ich nach diesen Kombinationen, die ersten 8 Stellen sind nur von Bedeutung, die nachfolgenden 7 Stellen ändern sich laufend, das Leerzeichen ist immer fest an der 5. Stelle:

0944 551*
0944 555*
0944 561*
0944 562*
0944 564*
0944 565*
0944 567*
0944 568*
0944 572*

Es ist aber mal möglich, das mehrere Zahlen wie diese in den Daten auftauchen, die nicht meiner Suche entsprechen:

0159 5092610222
0354 2568923411
usw.

und diese gilt es zu finden und in ein neues Tabellenblatt zu kopieren.



Mit diesem Code klappt das Suchen und Kopieren der Zahlen in ein anderes Blatt nach Muster "0944 555" wunderbar, jetzt brauch ich nur eine andere zusätzliche Lösung um alle die, die nicht meiner Suche entsprechen zu finden.

Code:

Mit diesem Code klappt es schon einmal alle Zahlen nach gesuchtem Muster einzufärben, die nicht dem Muster entspechen und die ich brauche, bleiben weiß.

Code:

 

Hallo Barti
Das Hochladen einer Beispieldate wird die Aussicht auf eine Antwort erhöhen.
Den deine Ausgangssituation nachzubauen macht keinen Spass.

Gruss,
Tinker Bell

 

HAllo,

Wenn du deine Kombinationen in eine Tabelle schreibst, wirds übersichtlich.
Teste mal dies:
Tabelle1

	A	B
1	0944 5675134856	0944 551
2	0944 5623931734	0944 555
3	0159 5092610222	0944 561
4	0354 2568923411	0944 562
5		0944 564
6		0944 565
7		0944 567
8		0944 568
9		0944 572

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4

Musst nur die Bereiche auf deine Tabelle anpassen.

ransi

 

Hallo ransi, vielen Dank für deine Mühe, der Code läuft!*Smilie

Ich habe die Muster wie empfohlen auch ins Tabellenblatt "Daten" S2-S10 kopiert.

Die ungesuchte Zahl wird im Blatt "Summe" ab A24 eingefügt, Toll.


Kann man den Code noch so anpassen das nicht nur die gefundenen Werte aus A ins andere Blatt kopiert werden sondern die Zeile A-L.






Der von mir angepasste, benutzte Code:
Code:

 

Hallo Barti,

Minimale Änderungen:

Option Explicit

Private Sub CommandButton23_Click()

Dim regex As Object
Dim arr As Variant
Dim Muster As Variant
Dim lngCount As Long
Dim L As Long 'geändert
Redim out(0)
Set regex = CreateObject("vbScript.regexp")
With Sheets("Daten")
arr = .Range("A2", .Cells(.Rows.Count, 12).End(xlUp)) 'geändert
Muster = .Range("S2", .Cells(.Rows.Count, 19).End(xlUp)) 'geändert
Muster = WorksheetFunction.Transpose(Muster)
End With
With regex
.Pattern = "^(" & Join(Muster, "|") & ").+"
For L = LBound(arr) To UBound(arr) 'geändert
If Not .test(arr(L, 1)) Then 'geändert
Redim Preserve out(lngCount)
out(lngCount) = WorksheetFunction.Index(arr, L, 0) 'geändert
lngCount = lngCount + 1
End If
Next
End With
'Ausgeben
Sheets("Summe").Range("a24").Resize(lngCount, 12) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(out)) 'geändert
End Sub


ransi

 

Vielen Dank für die Mühe, ich habe den geänderten Code installiert, er findet und kopiert die gefundenen Zeilen A-L wunderbar untereinander ins andere Tabellenblatt.

Aber wenn die Daten nach Muster alle OK sind, keine zu kopierenden Daten vorhanden sind, kommt ein Laufzeitfehler "104".
Anwendungs- oder objektdefinierter Fehler, in der letzten Spalte des Codes.

Sheets("Summe").Range("a24").Resize(lngCount, 12) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(out)) 'geändert

 

Hallo,

Ungetest:
if lngcount>0 then
'Ausgeben
Sheets("Summe").Range("a24").Resize(lngCount, 12) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(out)) 'geändert
end if
End Sub