Ähnlichkeitssuche
26.02.2018 14:59:24
Falcosn
gerne würde ich aus einer Liste gerne alle Zellen und Zelleninhalte auslesen, die jegliche Variation des Wortes "Leerstand" beinhalten. Dazu zählt z.B. "Leerstand *", "Leerstand1", "Leerstand X", "Leerstand_a" usw.
Folgendes Makro, zum Teil mit eurer Hilfe, habe ich dazu bis dato entwickelt.
Bisher habe ich erfolglos versucht die Variationskomponente mit *Leerstand* zu erreichen....
Tausend Dank!
Falcosn
Sub Test()
Dim vertikal As Integer
Range("A207").Select
vertikal = Selection.CurrentRegion.Rows.Count
Dim msg As String
msg = ""
Dim objMerk As Object, oObj, arrMerk()
Set objMerk = CreateObject("scripting.dictionary")
Dim Nutzung As Range
Dim k As Integer
'In Spalte "Nutzungsart" prüfen, ob Einheiten richtig benannt sind
For Each Nutzung In ActiveSheet.Range(Cells(207, 2), Cells(207 + vertikal, 2))
Select Case Nutzung
Case ActiveSheet.Range(Cells(207, 2), Cells(207 + vertikal, 2)).Find(what:="*Leerstand*", _
LookIn:=xlValues, lookat:=xlPart)
objMerk(Nutzung.Address(0, 0)) = Nutzung.Value
Case Else
' "objMerk definiert den Inhalt: Zellenkoordinaten & Zelleninhalt
End Select
Next Nutzung
k = 0
If objMerk.Count Then
'"arrMerk" wird definiert von 1 bis zur Anzahl der Einträgen die "ungleich" sind
ReDim arrMerk(1 To objMerk.Count)
For Each oObj In objMerk
k = k + 1
arrMerk(k) = oObj & " :" & vbTab & objMerk(oObj)
Next oObj
MsgBox "Folgende Zellen sind falsch befüllt:" & vbCrLf & Join(arrMerk, vbLf), vbInformation _
_
_
+ vbOKOnly, "Prüferergebnis"
Exit Sub
Else
MsgBox "Alle Zellen in der Spalte Nutzungsart sind richtig befüllt", vbInformation + vbOKOnly, " _
_
_
Prüfungsergebnis"
End If
End Sub