Zellwerte mit RegEx vergleichen

Forumthread: Zellwerte mit RegEx vergleichen

23.06.2016 13:29:14

Anton

Hallo Zusammen,
folgende AM: https://www.herber.de/bbs/user/106459.xlsm
In Tabelle1 Spalte A soll ein Muster gesucht werden. Falls das Muster nicht gefunden wird soll die komplette Zeile gelöscht werden. Wenn gefunden, soll das Muster in Tabelle2 Spalte B gesucht werden und mit Offset die zugehörige URL als Zellwert der ursprünglich gefunden Zelle in Tabelle1 Spalte A geschrieben werden.
Hier mein Ansatz:

Sub ZellenVergleichen()
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim zelle As Range
Dim objRegEx As New RegExp
Dim objMatch As MatchCollection
With objRegEx
.Global = False
.Pattern = "\d{5}."
End With
With Tabelle1
lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngZeile = 1 To lngZeileMax
Set objMatch = objRegEx.Execute(.Range("A" & lngZeile).Value)
If objMatch.Count  0 Then
For Each zelle In Tabelle2.UsedRange.Columns(2)
If zelle.Value = objMatch(0) Then
zelle.Offset(0, -1).Copy .Cells(lngZeile, 1).Value
End If
Next zelle
Else
.rows(lngZeile).delete
End If
Next lngZeile
End With
End Sub

Ist der Ansatz so ok oder habt ihr vielleicht Verbesserungsvorschläge. Evtl. könnte man die Spalte A&B in Tabelle2 in einen Array einlesen und dann vergleichen.
Danke für eure Unterstützung.
VG Anton

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zellwerte mit RegEx vergleichen

26.06.2016 07:22:18

fcs

AW: Zellwerte mit RegEx vergleichen

26.06.2016 07:22:18

fcs

Hallo Anton,
da du Zeilen in Tabelle 1 löscht musst du den Zeilen-Zähler der Schleife rückwärts laufen lassen, sonst werden Zeilen in der Auswertung nach jeder gelöschten Zeile übersprungen.
Außerdem sind in deinem Makro verschieden Syntaxfehler enthalten.

Sub ZellenVergleichen()
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim zelle As Range
Dim objRegEx As New RegExp
Dim objMatch As MatchCollection
With objRegEx
.Global = False
.Pattern = "\d{5}."
End With
With Tabelle1
lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
'      For lngZeile = 1 To lngZeileMax
For lngZeile = lngZeileMax To 1 Step -1
Set objMatch = objRegEx.Execute(.Range("A" & lngZeile).Value)
If objMatch.Count  0 Then
For Each zelle In Tabelle2.UsedRange.Columns(2).Cells
If zelle.Text = objMatch(0) Then
zelle.Offset(0, -1).Copy .Cells(lngZeile, 1)
End If
Next zelle
Else
.Rows(lngZeile).Delete
End If
Next lngZeile
End With
End Sub

Mit Optimierungen
- Makrobremsen vorübergehend deaktivieren
- Daten in Tabelle2 in Array einlesen
- Bei Zeilen ohne Match zunächst nur die Inhalte löschen
- Erst zum Schluss alle Leerzeilen in einer Anweisung löschen.
sieht es so aus:


Sub ZellenVergleichen_optimiert()
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim objRegEx As New RegExp
Dim objMatch As MatchCollection
Dim arrTab2
Dim lngZeile2 As Long
Dim StatusCalc As Long
With objRegEx
.Global = False
.Pattern = "\d{5}."
End With
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
'Vergleichsdaten in Array einlesen
With Tabelle2
lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
arrTab2 = .Range(.Cells(1, 1), .Cells(lngZeileMax, 2))
End With
With Tabelle1
lngZeileMax = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngZeile = 1 To lngZeileMax
Set objMatch = objRegEx.Execute(.Range("A" & lngZeile).Value)
If objMatch.Count  0 Then
For lngZeile2 = 1 To UBound(arrTab2, 1)
If CStr(arrTab2(lngZeile2, 2)) = objMatch(0) Then
.Cells(lngZeile, 1) = arrTab2(lngZeile2, 1)
Exit For 'nach Übereinstimmung Schleife verlassen
End If
Next lngZeile2
Else
'Zeileninhalt löschen
.Rows(lngZeile).Clear
End If
Next lngZeile
Erase arrTab2
With .Range(.Cells(1, 1), .Cells(lngZeileMax, 1))
'Leerzeilen ggf. löschen
If Application.WorksheetFunction.CountBlank(.Cells) > 0 Then
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
End With
End With
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
End Sub

Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Forumthread: Zellwerte mit RegEx vergleichen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread