VBA Zelle Vergleichen und bei Bedingung Kopieren, Finden

  • Excel

Es gibt 21 Antworten in diesem Thema. Der letzte Beitrag () ist von Sebastian_2004.

    VBA Zelle Vergleichen und bei Bedingung Kopieren, Finden

    Hallo Leute,

    Ich habe 2 Datensätze in einer Tabelle

    In Spalte A steht eine Nummer, in Spalte B und C jeweils Zusätze

    In Spalte E steht ebenso eine Nummer, in Spalte F und G jeweils Zusätze
    Am Sinnvollsten ist es glaub, wenn man jede einzelne Zeile durchprüft

    dacht ich jetzt wie folgt
    Bereich1Z = 2 'Zeile
    Bereich1SP = 1 'Spalte A

    Visual Basic-Quellcode

    1. Do While Tabelle1.Cells(Bereich1Z, Bereich1SP) <> ""
    2. ....????
    3. Bereich1Z = Bereich1Z+ 1
    4. Loop


    1. Bedingung: Das wäre auch schon die erste Bedingung, der Bereich 1 also (A bis C) darf nicht leer sein

    2. Bedingung: Wenn der erste Bereich in A1:A mit dem zweiten Bereich in E1:G gleich ist (Sprich eine Nummer identisch ist, sollen die restlichen Datensätze aktualisiert werden)

    3. Bedingung: Wenn im 2. Bereich nichts steht soll ebenfalls alles aus dem ersten Bereich angehängt werden (nicht überschreiben, da ich ansonsten hier Leerdatensätze erzeugen könnte

    Ich habe es mal noch als Dateiangehängt ums visuell besser zu verdeutlichen

    Weiß jemand wie das geht?
    Also reines Kopieren wenn hatte ich schon aber ich habs dann verworfen weil ich einfach nicht hinbekomme das er halt keine leeren Datensätze überträgt.

    Danke und solltet ihr verständlicherweise beschäftigt sein

    wünsch ich euch ein tolles Weihnachtsfest

    PS: Ich hab die Datei nochmal etwas optimiert dann wirds denk ich vollkommen klar was ich möchte

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „rabie“ ()

    Ich würde mir in einer ausgeblendeten Spalte (z.B. K) einen Suchindex anlegen, in der z.B. "1x131x1|Müller|Lindenaustr|Berlin" steht.
    Dann kannst du durch alle Zeilen gehen und einen Suchstring durch Verkettung der Spalten 1-4 bauen, den du mit .Find in dieser Spalte suchst.
    Bei nicht gefundenem Suchstring, kannst du die Zellen A bis D ans Ende von Spalte G kopieren.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hi Peta,

    das muss doch auch einfacher gehen... irgentwie alles zu kompliziert.
    Rein von der Überlegung

    Tabelle 1 (neue Daten werden eingelesen)
    Tabelle 2 (Hier kopier ich mal 2-3 Daten rein mit gleichen Stil)
    Tabelle 3 (Richtige Tabelle die Aktualisiert werden soll)

    Und zwar hat jeder Zeile (Datensatz) eine Nummer die indivudell ist. Nun müsste halt noch geprüft werden wenn Nummer in Tabelle 1 auch schon in Tabelle 2 oder 3 vorkommt dann aktualisiere diese Zeile in Tabelle 3 (überschreiben)
    Wichtig ist aber das eben keine Leerdatensätze entstehen, wenn zb in Tabelle 1 nur ein Datensatz ist oder garnix steht

    Ich verzweifel noch, eigentlich müsste es dass doch schon geben

    LG
    Ich brauch sowas ähnliches. Hab zwei Sheets, in Sheet 2 Spalte A stehen lauter Wörter drin, in B eine Nummer. Sheet 1 Spalte A enthält auch lauter Wörter. Nun will ich Sheet 2 Spalte A nach den Wörtern von Sheet 1 durchsuchen und bei einem Treffer die Nummer aus Spalte B ins erste Sheet kopieren, auch Spalte B. Hab mir das einfacher vorgestellt als es ist. Ein For Loop hat nicht funktioniert, muss wohl beide Spalten als Range deklarieren irgendwie.

    Diese Lösung funktioniert nicht, sieht auch ziemlich kompliziert aus, dabei dachte ist das sei trivial.

    Visual Basic-Quellcode

    1. Sub SearchString()
    2. Dim Sheet1 As Worksheet
    3. Dim Sheet2 As Worksheet
    4. Dim LastRow As Long
    5. Dim lRow As Long
    6. Dim SearchString As String
    7. Dim Found As Range
    8. Set Sheet1 = Worksheets("Tabelle1")
    9. Set Sheet2 = Worksheets("Tabelle2")
    10. LastRow = FindLastRow(Sheet1, "A")
    11. For lRow = 1 To LastRow
    12. SearchString = Sheet1.Cells(lRow, "A")
    13. Set Found = FindString(SearchString, Sheet2.Columns("A"), , xlPart)
    14. If Not (Found Is Nothing) Then
    15. Sheet1.Cells(lRow, "B") = Mid(Found, Len(SearchString) + 1, Len(Found))
    16. End If
    17. Next lRow
    18. Set Sheet1 = Nothing
    19. Set Sheet2 = Nothing
    20. End Sub
    21. Public Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
    22. FindLastRow = WS.Range(ColumnLetter & "65536").End(xlUp).Row
    23. End Function
    24. Function FindString(Find_Item As Variant, Search_Range As Range, _
    25. Optional LookIn As XlFindLookIn = xlValues, _
    26. Optional LookAt As XlLookAt = xlPart, _
    27. Optional MatchCase As Boolean = False) As Range
    28. Dim c As Range
    29. Set FindString = Nothing
    30. With Search_Range
    31. Set FindString = .Find( _
    32. What:=Find_Item, _
    33. LookIn:=LookIn, _
    34. LookAt:=LookAt, _
    35. SearchOrder:=xlByRows, _
    36. SearchDirection:=xlNext, _
    37. MatchCase:=MatchCase, _
    38. SearchFormat:=False)
    39. End With
    40. End Function
    Die Deklaration eines Range(Namen) is auf jeden fall sehr hilfreich, abbrechen über ne abfrage in der For..each schleife.

    in etwa so um den dreh

    Visual Basic-Quellcode

    1. Sub test()
    2. Dim Tab1, Tab2, Zelle, Suchzelle As Range
    3. Tab1 = Worksheets("Tabelle1").Range("A:A")
    4. Tab2 = Worksheets("Tabelle2").Range("A:A")
    5. For Each Zelle In Tab1
    6. If Zelle.Value = "" Then Exit For
    7. For Each Suchzelle In Tab2
    8. If Suchzelle = "" Then Exit For
    9. If Suchzelle = Zelle Then
    10. Zelle.Offset(0, 1) = Suchzelle.Offset(0, 1)
    11. Exit For
    12. End If
    13. Next Suchzelle
    14. Next Zelle
    15. End Sub


    musste noch anpassen für deine Zwecke. Das hier geht davon aus, das jeder Wert in Tabelle 2 nur einmal vorkommt
    Danke, leider kommt "424, Objekt erforderlich" bei diesem Schritt

    If Zelle.Value = "" Then

    Ansonsten sieht das recht simpel aus.

    In der zweiten Tabelle gibt es auch jeden String und jede Nummer nur einmal. In Tabelle 1 können sich einige wiederholen.
    Oh sorry mein Fehler....

    Visual Basic-Quellcode

    1. Sub test()
    2. Dim Tab1, Tab2, Zelle, Suchzelle As Range
    3. Set Tab1 = Worksheets("Tabelle1").Range("A:A")
    4. Set Tab2 = Worksheets("Tabelle2").Range("A:A")
    5. For Each Zelle In Tab1
    6. If Zelle = "" Then Exit For
    7. For Each Suchzelle In Tab2
    8. If Suchzelle = "" Then Exit For
    9. If Suchzelle = Zelle Then
    10. Zelle.Offset(0, 1) = Suchzelle.Offset(0, 1)
    11. Exit For
    12. End If
    13. Next Suchzelle
    14. Next Zelle
    15. End Sub


    Der Range muss natürlich mit Set gesetht werden, der Vergleich kann auf das .value verzichten ... :whistling: :whistling: :whistling:
    Danke schön das funktioniert. Das war der einfachste Teil, nun kommt der schwere.
    Die Wörter sind natürlich nicht exakt gleich sondern manchmal nur ähnlich, vor allem wenn eines weiblich ausgedrückt wird, in der Liste aber männlich steht. Im Endeffekt bin ich dann wieder hier gelandet:

    [Allgemein] Wörter kodieren, Strings vergleichen
    [Excel] Anforderungen an ein komplexes Kodierungsprogramm

    Als erstes würde ich also die einfache Form von Levenshtein benutzen um auch ähnliche Wörter zu finden. Später kommt dann noch mehr hinzu.
    Fragt sich nur wie man das implementiert. Finde zwar die Funktion im Web aber die alleine für sich funktioniert ja noch nicht, außerdem soll sie nur eine Zahl zurückgeben, nämlich wie sehr sich die beiden Strings unterscheiden. In meinem Fall wären die beiden Wörter als gleich zu sehen wenn die Zahl geringer ist als 5 oder so und dann wird der Code weiter ausgeführt und die Zahl kopiert.

    Statt dieser Zeile

    If Suchzelle = Zelle Then
    Zelle.Offset(0, 1) = Suchzelle.Offset(0, 1)

    dann also

    If Lev_Function < 5 Then
    Zelle.Offset(0, 1) = Suchzelle.Offset(0, 1)

    ?
    Gibt sie leider nicht, so geht es also nicht (Argument ist nicht optional).
    Ich finde auch mehrere verschiedene Versionen, oftmals erscheinen Teile des Codes in rot, sind also von Grund auf schon mal nicht kompilierbar.
    Ohne Angabe ist es ByRef, das funzt nicht, ByVal aber auch nicht. In den Beispielen klappt immer alles wunderbar, in der Realität dann nicht.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Artifi“ ()

    Das sind Berufsbezeichnungen wobei wir damit wieder hier wären:
    [Excel] Anforderungen an ein komplexes Kodierungsprogramm

    Hab diese Funktion eingefügt:

    Visual Basic-Quellcode

    1. Public Function Levenshtein(ByVal s1 As String, ByVal s2 As String) As Integer
    2. Dim i As Integer
    3. Dim j As Integer
    4. Dim l1 As Integer
    5. Dim l2 As Integer
    6. Dim d() As Integer
    7. Dim min1 As Integer
    8. Dim min2 As Integer
    9. l1 = Len(s1)
    10. l2 = Len(s2)
    11. ReDim d(l1, l2)
    12. For i = 0 To l1
    13. d(i, 0) = i
    14. Next
    15. For j = 0 To l2
    16. d(0, j) = j
    17. Next
    18. For i = 1 To l1
    19. For j = 1 To l2
    20. If Mid(s1, i, 1) = Mid(s2, j, 1) Then
    21. d(i, j) = d(i - 1, j - 1)
    22. Else
    23. min1 = d(i - 1, j) + 1
    24. min2 = d(i, j - 1) + 1
    25. If min2 < min1 Then
    26. min1 = min2
    27. End If
    28. min2 = d(i - 1, j - 1) + 1
    29. If min2 < min1 Then
    30. min1 = min2
    31. End If
    32. d(i, j) = min1
    33. End If
    34. Next
    35. Next
    36. Levenshtein = d(l1, l2)
    37. End Function


    Statt " If Suchzelle = Zelle Then" dann "If Levenshtein(Eingabe, Vorgabe) < 5 Then" aber funktioniert so nicht, gibt die Funktion also nicht her.

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Artifi“ ()

    Hab mal die Datei angehängt mit der ich arbeite. Man sieht dort wie umfangreich das alles ist.

    Eine andere Funktion ausprobieren? Im Endeffekt müssen es wohl mehrere sein die nach und nach abgefragt werden, je nachdem welche Bedingung erfüllt wird oder welche besser funktioniert. Es könnten jeweils MsgBoxen mit Vorschlägen kommen die man nach und nach ablehnt oder annimmt.
    Dateien
    • Vorlage.zip

      (441,96 kB, 361 mal heruntergeladen, zuletzt: )

    Artifi schrieb:

    Statt " If Suchzelle = Zelle Then" dann "If Levenshtein(Eingabe, Vorgabe) < 5 Then" aber funktioniert so nicht, gibt die Funktion also nicht her.

    na deine erste Abfrage muss ja schon bleiben... sprich

    Visual Basic-Quellcode

    1. if Suchzelle = Zelle or levenshtein(Eingabe, Vorgabe) < 5 then
    2. 'Dein Code
    3. else
    4. 'bla
    5. end if


    btw.. in deiner Datei is kein Code?
    zeig mal deinen generellen Stand.. nur mit so ner Excelliste mit 25 Berufen.. was soll man da schauen?

    Ein Idee hab ich noch...
    Ein Aufsplitten vielleicht.. wenn man sich generell solch Bezeichnungen anschaut ist ja fürs weibliche nur ein "in" angehängt.
    Schreib eine Liste, wo es nich so is (Arzt/ Ärtzin,...) geh die durch... wenns nich dabei is kannste dann ja Vergleichen indem du halt von der Eingabe eine Umwandlung männlein->Weiblein machst...

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „FloFuchs“ ()

    Ich häng heute Abend mal die Datei an mit der ich arbeite. Ist halt eine xlsm Datei.

    Wir haben heute überlegt ob man das nicht manueller machen soll, also man nimmt sich ein paar Beispielberufe, nimmt dort einen Wortstamm "erzieh" und sucht die Liste nach diesem Begriff ab, diese kommen dann in eine neue Datei, so hat man das wenigstens schon mal verkleinert, die Nummern sind nämlich oft gleich.
    Das macht man für ein paar mehr Berufe, die wichtigsten. Also sowas wie If "*erzieh*" like "was in der Datenbank steht" dann extrahier das.

    Das Geschlechter aufsplitten kann man machen aber das ist ja nur eine geringfügige Änderung und eigentlich sollte die Master Datenbank so bleiben, hatte mal eine rein männliche erstellt.

    Cool wärs wie bei der Bahn. Man kann bei bahn.de ja auch Start und Ziel eingeben, sich vertippen oder falsch herum schreiben und er findet trotzdem die richtige Haltestelle; wenn es zu sehr anders ist, gibt es mehrere Vorschläge aus denen man wählen kann. Sogar eine Straße kann man eingeben und er findet die nächstgelegene Haltestelle und den Fussweg dahin auf einer Karte. Wie man das wohl gemacht hat.
    Dateien
    • Vorlagentest.zip

      (552,49 kB, 1.825 mal heruntergeladen, zuletzt: )

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Artifi“ ()