Thema: Zellen aufgrund Bedingungen ersetzen (VBA)

Hallo und noch ein gutes Neues Jahr,
ich bekomme regelmäßig von Extern Dateien mit Namen mit Anschriften, die ich ergänzen / berichtigen muss; vielfach wiederholen sich die Daten und die gelieferten Fehler.
Derzeit recherchiere ich die Adresse im WWW und trage diese richtigen Daten immer wieder manuell in die korrupte (=undefinerte) Zelle ein.
Künftig möchte ich die Daten in eine Prozedur eintragen, die ich immer wieder laufen lassen kann.
Das sollte so variabel sein, dass zuerst jeweils über eine InputBox den Spalten für Name, Straße, Hausnr. PLZ, Ort und dann auch für den undefinierten Vornamen eine Variable zugeordnet wird und dann im Code dies berücksichtig wird.
Beispiel siehe upload: https://www.herber.de/bbs/user/174634.xlsb
Wenn in NAME "Obernberger" steht, in der STRASSE "Birkenweg" und in der HAUSNR "13" steht, dann schreibe, wenn in VORNAME "undefiniert" steht, das Wort "Hans-Peter" rein, wenn nicht "undefiniert" steht, belasse es wie es ist.
Das sind zwar etwas viele Bedingungen, aber mit VBA sollte es gehen (bitte kein sverweis o. ä.).
Danke für euere Mühe - Erwin

Hallo Erwin!

Die Datenpflege ist natürlich bei solchen Ansätzen ein Graus, aber wenn du es so haben willst: bitte.

Sub Namensliste_vervollständigen()



    Dim Adr_schlüssel As String

    Dim suchspalte As Long

    Dim Beginn As Long

    Dim cl As Range

    Dim Vorname As String

    

    suchspalte = Application.InputBox("Name", "In welcher Spalte steht der Name?", 3, Type:=1)

    Beginn = Application.InputBox("Beginn", "In welcher Zeile soll mit der Suche und dem Austausch begonnen werden?", 3, Type:=1)

    

    For Each cl In Columns(suchspalte).SpecialCells(xlCellTypeConstants)

        If cl.Row < Beginn Or cl.Value <> "undefiniert" Then GoTo nächste

        

        'Schlüssel herleiten

        Adr_schlüssel = Cells(cl.Row, "B") & "_" & Cells(cl.Row, "D") & "_" & Cells(cl.Row, "E")

        'nach Schlüssel eintragen

        

        Select Case Adr_schlüssel

            Case "Obernberger_Birkenweg_13": Vorname = "Hans-Peter"

            Case "Sommerer_Rodensteinstr._25": Vorname = "Bernd"

            Case "Heck_Südring_3": Vorname = "Karl-Heinz"

            Case "Schulte-Münch_Bahnhofstr._38": Vorname = "Frauke"

            Case "Thewes_Ringstr._7": Vorname = "Josephine"

            Case "Schmid_Waldweg_11": Vorname = "Michael"

            Case Else: Vorname = "undefiniert"

        End Select

        

        Cells(cl.Row, "C") = Vorname

        

nächste:

    Next cl

End Sub

Gruß, MCO

Moin Erwin!

Geänderter Schlüssel bedeutet dann auch einen geänderten Case.
Die Abfrage hab ich mal so gemacht, dass bei Angabe von Spalte 99 der Wert ignoriert wird.
Den gestutzen Schlüssel hab ich mit in select case eingebaut.

Sub Namensliste_vervollständigen()



    Dim Adr_schlüssel As String

    Dim suchspalte As Long

    Dim Beginn As Long

    Dim cl As Range

'    Dim Name As String

    Dim Vorname As String

'    Dim Straße As String

'    Dim Nummer As String

'    Dim PLZ As String

'    Dim Ort As String

    

    Application.ReferenceStyle = xlR1C1  'Spaltenbuchstaben in Zahlen umwandeln

    suchspalte = Application.InputBox("Vorname", "In welcher Spalte steht im Vornamen 'undefiniert'?", 3, Type:=1)

    Name = Application.InputBox("Name", "In welcher Spalte steht der Name?", 2, Type:=1)

    Straße = Application.InputBox("Straße", "In welcher Spalte steht die Straße?", 4, Type:=1)

    Nummer = Application.InputBox("Nummer", "In welcher Spalte steht die Nummer?", 5, Type:=1)

    PLZ = Application.InputBox("PLZ  (übergehen = 99)", "In welcher Spalte steht die PLZ?", 6, Type:=1)

'    Ort = Application.InputBox("Ort", "In welcher Spalte steht der Ort?", 7, Type:=1)

    Application.ReferenceStyle = xlA1    'Spaltenzahlen wieder in Buchstaben zurück-umwandeln

    

    Beginn = Application.InputBox("Beginn", "In welcher Zeile soll mit der Suche und dem Austausch begonnen werden?", 3, Type:=1)

    

    For Each cl In Columns(suchspalte).SpecialCells(xlCellTypeConstants)

        If cl.Row < Beginn Or cl.Value <> "undefiniert" Then GoTo nächste

        

        'Schlüssel herleiten

        Adr_schlüssel = Cells(cl.Row, Name) & "_" & Cells(cl.Row, Straße) & "_" & Cells(cl.Row, Nummer) & IIf(PLZ <> 99, "_" & Cells(cl.Row, PLZ), "")

        'nach Schlüssel eintragen

        

        Select Case Adr_schlüssel

            Case "Obernberger_Birkenweg_13_82256", "Obernberger_Birkenweg_13": Vorname = "Hans-Peter"

            Case "Sommerer_Rodensteinstr._25": Vorname = "Bernd"

            Case "Heck_Südring_3": Vorname = "Karl-Heinz"

            Case "Schulte-Münch_Bahnhofstr._38": Vorname = "Frauke"

            Case "Thewes_Ringstr._7": Vorname = "Josephine"

            Case "Schmid_Waldweg_11": Vorname = "Michael"

            Case Else: Vorname = "undefiniert"

        End Select

        

        Cells(cl.Row, suchspalte) = Vorname    'in der Variable "Suchspalte" wird der Vorname eingetragen

        

nächste:

    Next cl

End Sub

Gruß, MCO

Hallo
ich halte es für Suboptimal, deine Adressdaten im Code zu hinterlegen.
die Liste "lebt" wahrscheinlich, es kommen immer neue Adressen hinzu oder müssen geändert werden, daher ist es besser, die Liste mit den vollständigen Adressen in einem Tabellenblatt zu hinterlegen.

mach mal folgendes:
1. Schreibe die Liste mit den vollständigen Adressen in das Blatt Tabelle2 (gleiche Spalten verwenden)
2. füge die neuen Listen, die überarbeitet werden sollen, in Tabelle1 ein (so wie im beispiel)
3. wende dann dieses Makro an.
Das Makro ergänzt die "undefinert", sofern es für die restlichen Daten einen passenden Eintrag finden kann.
Wenn es keinen passenden Eintrag finden kann, fügt es diese Zeile deinen Daten in Tabelle2 hinzu, dort kannst du dann die fehlenden Werte ergänzen und den Vorgang wiederholen:

Sub Namensliste_vervollständigen_neu()

Dim Zelle As Range

Dim txt As String

Dim x

Dim CheckNeu As Boolean

Sheets("Tabelle2").Columns(2).SpecialCells(xlCellTypeConstants).Offset(0, -1).FormulaR1C1 = "=concat(RC2:RC7)"



With Sheets("Tabelle1").Range("B:G")

    .Cells.Replace "undefiniert", True, xlWhole

    If WorksheetFunction.CountIf(.Cells, True) Then

        For Each Zelle In .Cells.SpecialCells(xlCellTypeConstants, 4)

            txt = WorksheetFunction.Concat(Intersect(.Cells, Zelle.EntireRow))

            txt = Replace(txt, "TRUE", "*")

            x = Application.Match(txt, Sheets("Tabelle2").Columns(1), 0)

            If Not IsError(x) Then

                Zelle.Value = Sheets("Tabelle2").Cells(x, Zelle.Column).Value

                CheckNeu = True

            End If

        Next

    End If

    If WorksheetFunction.CountIf(.Cells, True) Then

        Intersect(.Cells, .SpecialCells(xlCellTypeConstants, 4).EntireRow).Copy

        Sheets("Tabelle2").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll

        Sheets("Tabelle2").Select

        Sheets("Tabelle2").Range("B:G").RemoveDuplicates Array(1, 2, 3, 4, 5, 6), xlYes

        MsgBox "Es sind neue unvollständige Adressdaten vorhanden. Bitte hier ergänzen und Vorgang wiederholen."

    End If

    

End With

        

End Sub

gruß Daniel

Hallo Daniel,

Danke für sie supergute Lösung (wie immer).
Natürlich hast du Recht, dass Adressdaten nichts im Code zu suchen haben, aber mir ist nichts anderes eingefallen.

Jetzt muss ich das nur noch flexibilisieren, weil die Daten natürlich nicht in B3 beginnen sondern mal hier und mal dort.
Ich werde versuchen, das Ganze über Inputboxen und Variablen zu lösen.

Grüße - Erwin

was ändert sich denn immer?
die Zeilen sind bei meiner Varianten unwichtig.
wenn sich da was ändert, brauchst du den Code nicht anpassen.
In der Sammlung der vollständigen Adressen sollte sich sowieso nichts was ändern (Tabelle2)

Gruß Daniel

Hallo Daniel,
der Name steht in der eigentlichen Datei nicht in B3 sondern sagen wir in G9, der Vorname in H9, die Strasse in I9 und so weiter (natürlich muss ich die Referenztabelle auch so bauen).
Ich dachte, ich müsste den Code dann so anpassen, dass ich z.B. über Inputbox irgendwie den Start festlege, eben G9, damit der Textstring richtig zusammengesetzt wird.
Grüße - Erwin

Hi

im prinzip sollte das hier reichen:

Dim sp As String



sp = InputBox("Erste Spalte der Adresse (Name)")

If sp = "" Then Exit Sub







Sheets("Tabelle2").Columns(2).SpecialCells(xlCellTypeConstants).Offset(0, -1).FormulaR1C1 = "=concat(RC2:RC7)"



With Sheets("Tabelle1").Range(sp & "1").EntireColumn.Resize(, 6)

der rest referenziert ja auf den Zellbereich der WITH-Klammer, daher reicht es, das hier zu ändern.

die Tabelle2 mit den vollständigen werten steht immer in Spalte B.

Gruß Daniel

Hallo Daniel,

konnte es erst gerade eben nachbauen und hab mal die Daten in der Tabelle1 verschoben und dann die Variable benutzt
Beispieldatei: https://www.herber.de/bbs/user/174741.xlsb
Jetzt wird anstelle des Vornamens die PLZ eingetragen, wahrscheinlich weil ich vorne Spalten eingefügt habe und sich alles nach rechts verschoben hat.
Kannst du bitte noch ändern?

Danke - Erwin

Zelle.Value = Sheets("Tabelle2").Cells(x, Zelle.Column - .Column + 2).Value

Hallo MCO,

ich war den ganzen Tag unterwegs und konnte erst jetzt testen.

Deine Lösung funktioniert natürlich, aber ich muss dann Name_Straße_Nr doppelt eintragen.. einmal noch mit PLZ.

Ich hätte es mir einfacher vorgestellt; nämlich in etwa so, nimm das was da ist (getrennt mit _) und prüfe... wenn du keinen Wert z. B. für die Hausnummer findest, akzeptiere auch einen Platzhalter in Form von * oder % und mache mit dem Rest trotzdem die Prüfng.
z. B.: "Obernberger__Birkenweg_13_%_Fürstenfeldbruck": Vorname = "Hans-Peter"
"Sommerer_Rodensteinstr._%_%_Köln": Vorname = "Bernd"
"Heck_%_3_45879_%": Vorname = "Karl-Heinz"
Damit müsste ich die Daten nicht doppelt erfassen und jeder Datensatz hätte den gleichen Aufbau.
Sicherheitshalber nochmals die Datei: https://www.herber.de/bbs/user/174714.xlsb

Grüße - Erwin

Moin!

Den Case-Eintrag hab ich jetzt mal angepasst. Damit wird dann nur noch der Linke Teil des Eintrages kontrolliert, in der Länge, wie auch der Adressschlüssel ist.
Damit könntest du dann auch beginnend mit Postleitzahl 82 abprüfen.

Außerdem war die Zuordnung der Adresszeile nicht ganz in Ordnung. Daher bitte folgende Zeilen ersetzen:

        Adr_schlüssel = Cells(cl.Row, Name) & "_" & Cells(cl.Row, Straße) & "_" & Cells(cl.Row, Nummer) & IIf(PLZ <> 99, "_" & Cells(cl.Row, PLZ), "")

            Case Left("Obernberger_Birkenweg_13_82256", Len(Adr_schlüssel)): Vorname = "Hans-Peter"

Die CASE-Zeile muss natürlich nach diesem Muster für alle Fälle eingetragen werden.
Das ganze Funktioniert auch nur, solang der fehlende Begriff rechts steht. Möglich wäre also zusätzlich auf die Hausnummer zu verzichten, jedoch nicht aussschließlich, da sie nicht rechts steht.

Weitere Möglichkeiten, Begriffe als gültig oder nicht gültig zu vergleichen findest du hier:
https://www.vba-tutorial.de/applikation/regexp.htm

Viel Erfolg!

Gruß, MCO

Hallo MCO,

wie g**l ist das denn?!!!
Super Lösung, genau so wie ich es haben wollte.
Und das allerbeste, ich kann es auch lesen und für zusätzliche Adressen selbst erweitern.

Vielen Dank - Erwin

Hallo,

obwol die Lösung klappt (ich habe das nun so weit wie möglich flexibilisiert) hätte ich nun doch noch eine Frage:
Wenn ich die PLZ noch einbinden möchte (s. Datei) klappt es, wenn ich diese mit "_82256" in ...case Adr_schlüssel... eintrage, dann sind alle 4 Bedingungen erfüllt.
Leider muss ich immer alle 4 Kriterien benutzen, die im Schlüssel definiert sind.
Wie kann ich einen Schlüssel übergehen bzw. einen Platzhalter (z. B. * ? % ...) benutzem und damit sagen, egal was in der PLZ (oder in der Straße, der Nummer, ...) steht, nimm einfach das was da ist und ignoriere das was nicht da ist (z. B. PLZ, ...) und mache trotzdem die Änderung?
https://www.herber.de/bbs/user/174676.xlsb

Grüße - Erwin