---

tabelle_test.zip

Hallo zusammen,
ich melde mich wieder mal mit einem VB - Problem.

Wir haben eine Arbeitsmappe mit den Reitern "Eingabe" und "Daten" (siehe Anhang).

Ich möchte eine Abfrage machen, ob der Wert AB (in "Eingabe" Feld D5) in der Spalte A in "Daten" bereits vorhanden ist. Normalerweise wäre das ja eine sverweis - Geschichte, aber in VB bin ich da nicht sooo sattelfest ...

Ist die Abfrage positiv (Eintrag vorhanden), soll das Makro beendet werden mit der msgbox "Bereits vorhanden". Ist die Abfrage negativ, sollen die Werte D4 (TW) und D5 (AB) in die nächste leere Zeile der Tabelle eingetragen werden (Schmankerl: msgbox "Werte eingetragen").

Das Eintragen an sich hab ich schon rausgefunden mit
Range("A1").End(xlDown).Offset(1, 0).Value = AB
Range("A1").End(xlDown).Offset(0, 1).Value = TW

Und statt der sverweis Funktion aus xls kann man die VLookup nehmen - das hab ich auch schon gelernt ...

Aber wie verhält es sich, wenn die Werte geprüft werden sollen? Ich meine, der Suchbereich ändert sich ja mit jeder neuen Zeile ... *konfus* 

Hat wer von euch vielleicht eine zündende Idee, oder hab ich nur einen Knopf im Hirn?
Wenn geht mit ein bisschen Kommentar, damit ich auch mitkomme ... 

Danke danke Ihr seid die Besten!  

Lob, Dank und Anerkennung bereits im voraus.

Gruß
3DFreak 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo 3DFreak

Das Überprüfen ob ein Wert schon eingetragen wurde, kann man mit Range.Find machen.

Code:

---

Sub Eingabe_pruefen()

    Dim AB As Double
    Dim TW As Double
    Dim SearchResult As Range

    AB = Sheets("Eingabe").Range("D5").Value
    TW = Sheets("Eingabe").Range("D4").Value
   
    'Überprüfen ob AB in Spalte A vorhanden ist
    Set SearchResult = Sheets("Daten").Range("A:A").Find(AB, LookIn:=xlValues, LookAt:=xlWhole)
    If SearchResult Is Nothing Then
        'Werte eintragen
        Sheets("Daten").Range("A1").End(xlDown).Offset(1, 0).Value = AB
        Sheets("Daten").Range("A1").End(xlDown).Offset(0, 1).Value = TW
        MsgBox "Wert wurden eingetragen", vbInformation & vbOKOnly, "Wert eigetragen"
    Else
        'Meldung das Wert vorhanden ist
        MsgBox "Wert ist schon vorhanden und zwar in Zelle " + SearchResult.Address, vbCritical & vbOKOnly, "Doppelter Wert"
    End If

End Sub

---

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo HenryV,
also ich sitz jetz mit offenem Mund vorm PC und staune wie ein Kugelfisch ... 

Einen recht herzlichen Dank für die prompte Lösung ...

Gruß
3DFreak 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo HenryV,
eine Frage hätte ich noch: wie würde der code aussehen, wenn

- das Feld "AB" UND "TW" gesucht werden sollen?

muss ich dann das ganze nochmal machen (vielleicht mit SearchResultAB und SearchResultTW)? 

DANKE DANKE DANKE!!!!!

Gruß
3DFreak 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo 3DFreak

Kommt ganz darauf an was du erreichen willst.

Willst du a) beides einzeln suchen oder willst du b) die Kombination beider Werte suchen.

a) ist einfach

Code:

---

Sub Eingabe2_pruefen()

    Dim AB As Double
    Dim TW As Double
    Dim SearchResultAB As Range
    Dim SearchResultTW As Range

    AB = Sheets("Eingabe").Range("D5").Value
    TW = Sheets("Eingabe").Range("D4").Value

    'Überprüfen ob AB in Spalte A vorhanden ist
    Set SearchResultAB = Sheets("Daten").Range("A:A").Find(AB, LookIn:=xlValues, LookAt:=xlWhole)
    'Überprüfen ob TW in Spalte B vorhanden ist
    Set SearchResultTW = Sheets("Daten").Range("B:B").Find(TW, LookIn:=xlValues, LookAt:=xlWhole)

    If SearchResultAB Is Nothing And SearchResultTW Is Nothing Then
        'Werte eintragen
        Sheets("Daten").Range("A1").End(xlDown).Offset(1, 0).Value = AB
        Sheets("Daten").Range("A1").End(xlDown).Offset(0, 1).Value = TW
        MsgBox "Wert wurden eingetragen", vbInformation & vbOKOnly, "Wert eigetragen"
    Else
        'Meldung das Wert vorhanden ist
        MsgBox "Wert ist schon vorhanden und zwar in Zelle " + SearchResultAB.Address + " und " + SearchResultTW.Address, vbCritical & vbOKOnly, "Doppelter Wert"
    End If
End Sub

---

b) ist komplizierter

Code:

---

Sub Eingabe3_pruefen()

    Dim AB As Double
    Dim TW As Double
    Dim SearchResult As Range
    Dim firstAddress As String

    AB = Sheets("Eingabe").Range("D5").Value
    TW = Sheets("Eingabe").Range("D4").Value

    'Überprüfen ob AB in Spalte A vorhanden ist und TW dazu passt
    With Sheets("Daten").Range("A:A")
        Set SearchResult = .Find(AB, LookIn:=xlValues, LookAt:=xlWhole)
        If Not SearchResult Is Nothing Then
            firstAddress = SearchResult.Address
            Do
                If SearchResult.Offset(0, 1).Value = TW Then
                    'Meldung das Wert vorhanden ist und abbrechen
                    MsgBox "Wert ist schon vorhanden und zwar in Zelle " + SearchResult.Address, vbCritical & vbOKOnly, "Doppelter Wert"
                    Exit Sub
                End If
                Set SearchResult = .FindNext(SearchResult)
            Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstAddress
        End If
    End With
   
    'Werte eintragen
    Sheets("Daten").Range("A1").End(xlDown).Offset(1, 0).Value = AB
    Sheets("Daten").Range("A1").End(xlDown).Offset(0, 1).Value = TW
    MsgBox "Wert wurden eingetragen", vbInformation & vbOKOnly, "Wert eigetragen"

End Sub

---

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Andreas,
boah du bist ja ein echter Freak ... Wahnsinn ... DANKE!
Die kompliziertere Variante scheint sehr sinnvoll, da der Wert in TW öfter als 1x vorkommen kann.
Um vielleicht die Effizienz ein wenig zu steigern schildere ich Dir die eigentliche Aufgabenstellung:

Der Konstrukteur soll eine neue Maschine konstruieren und gibt die Werte in der Tabelle "Eingabe" ein. Um doppelte Artikelnummern einzelner Teile (in der Tabelle "Liste" Spalte C bis E) zu vermeiden, startet er die Abfrage. Ist nun die Kombination AB und TW neu, so wird das eingetragen. Das ist das bisherige Ergebnis.

Perfekt wäre, wenn im Fall "neue Kombination" sich ein Fenster öffnet in dem der Konstrukteur aufgefordert wird, die neuen Artikelnummern einzugeben (zB "ArtikelNr. x: ", "ArtikelNr. y: ", "ArtikelNr. z: "). Diese Werte sind dann in der "Liste" in den Spalten C bis E in der jeweiligen Zeile des "SearchResults" zu übernehmen.
Ist das SearchResult positiv - also die Kombination bereits vorhanden - soll sich ein Fenster öffnen und die jeweiligen Artikelnummern der Spalten C bis E anzeigen.

Sollte das jetzt zu theoretisch sein, lade ich morgen eine neue Version der Arbeitsmappe hoch.

Ist das noch mit vertretbarem Aufwand realisierbar?
Dafür hab ich leider viel zu wenig VB - Erfahrung ... SORRY!

Boah, du bist echt ein Wahnsinn ... Wie kann ich mich revanchieren?   

Herzlichsten Dank bereits im voraus.

Gruß aus Österreich,
Wolfgang alias "3DFreak" 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo 3DFreak

Ich hoffe ich habe dich richtig verstanden.

Code:

---

Sub Eingabe4_pruefen()

    Dim AB As Double
    Dim TW As Double
    Dim SearchResult As Range
    Dim firstAddress As String
    Dim ArtikelNr As String
    Dim InputZelle As Range

    AB = Sheets("Eingabe").Range("D5").Value
    TW = Sheets("Eingabe").Range("D4").Value

    'Überprüfen ob AB in Spalte A vorhanden ist und TW dazu passt
    With Sheets("Daten").Range("A:A")
        Set SearchResult = .Find(AB, LookIn:=xlValues, LookAt:=xlWhole)
        If Not SearchResult Is Nothing Then
            firstAddress = SearchResult.Address
            Do
                If SearchResult.Offset(0, 1).Value = TW Then
                    'Meldung das Wert vorhanden ist und abbrechen

                    ArtikelNr = "ArtikelNr.x: " + SearchResult.Offset(0, 2).Value
                    ArtikelNr = ArtikelNr + vbCrLf + "ArtikelNr.y: " + SearchResult.Offset(0, 3).Value
                    ArtikelNr = ArtikelNr + vbCrLf + "ArtikelNr.z: " + SearchResult.Offset(0, 4).Value

                    MsgBox "Wert ist schon vorhanden." + vbCrLf + "Die Artikelnummern lauten:" + vbCrLf + ArtikelNr, vbInformation & vbOKOnly, "Doppelter Wert"

                    Exit Sub
                End If
                Set SearchResult = .FindNext(SearchResult)
            Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstAddress
        End If
    End With

    'Werte eintragen
    Set InputZelle = Sheets("Daten").Range("A1").End(xlDown).Offset(1, 0)

    InputZelle.Value = AB
    InputZelle.Offset(0, 1).Value = TW

    InputZelle.Offset(0, 2).Value = InputBox("Bitte geben Sie ArtikelNr x ein", "Eingabe der Artikelnummer")
    InputZelle.Offset(0, 3).Value = InputBox("Bitte geben Sie ArtikelNr y ein", "Eingabe der Artikelnummer")
    InputZelle.Offset(0, 4).Value = InputBox("Bitte geben Sie ArtikelNr z ein", "Eingabe der Artikelnummer")

    MsgBox "Wert wurden eingetragen", vbInformation & vbOKOnly, "Wert eigetragen"

End Sub

---

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Andreas,
du bist echt der Knaller!

DANKE!

Genau das, was mir gefehlt hat.

Funktioniert PERFEKT!

Gruß
Wolfgang

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP