Spalte nach Wort durchsuchen VBA Code

Question

Hallo ihr Lieben,

ich habe noch folgende Frage:

Ich suche einen VBA Code der folgendes ausführt.

Er soll den Inhalt einer bestimmten Spalte durchsuchen.
Dies nach dem Inhalt eines vorher festgelegten Feldes.
Wenn die Nr gefunden wurde in der Spalte soll keine Meldung erscheinen. Wenn er die Nummer allerdings nicht findet in der Spalte, soll eine meldung erscheinen.

Bsp:

In Feld A1 im Tabellenblatt "Hallo" steht 12345

in einem anderen Tabellenblatt "Hauptdatei" in Spalte 1 stehen viele Zahlen untereinander

89789
234745
203814
12345

Der Code soll die Spalte durchsuchen nach dem Feld A1 (12345)
Da er was gefunden hat erscheint Keine Meldung.

Steht jetzt im Feld A1 z.b. 99999 und er durchsucht die Spalte findet er natürlich nichts. Als Meldung soll dann erscheinen: "Nr nicht vorhanden ... Neu anlegen".


Ich weiß leider nicht, wie ich das am besten in einen VBA Code packen kann, sodass er funktioniert.

Vielen Dank für eure Hilfe schonmal im Voraus.

Gruß Dominik

Answer 1

Hallo Dominik,
Code in Tabelle2 einfügen.

Kann gelöscht werden nach dem Testen:
MsgBox "Eintrag vorhanden"


Sub Finden()
Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Sheets("Tabelle2").Range("A1:A" & Range("A65536").End(xlUp).Row)
With rngBer
strSuch = Sheets("Tabelle1").Range("A1").Value
If strSuch = "" Then
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Eintrag nicht vorhanden"
Else
firstAddress = c.Address
Do
MsgBox "Eintrag vorhanden"
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

Gruß
fedjo

Answer 2

Hallo Dominik,

hier ein weiterer Vorschlag (- früher angefangen, aber später fertig geworden als fedjo/AW1):

Sub Spalte_durchsuchen()

Dim Suche As Range
Dim SuchSpalte As Integer, SuchZeileVon As Integer, SuchZeileBis As Integer, SuchNummer As Integer
Dim SuchWertZelle As String

'### Diese Werte anpassen ###
SuchSpalte = 28
SuchZeileVon = 1
SuchZeileBis = ThisWorkbook.Worksheets("Tabelle1").Cells(Rows.Count, SuchSpalte).End(xlUp).Row
SuchWertZelle = "A1"
'### Diese Werte anpassen ###

SuchNummer = CInt(Worksheets("Tabelle1").Range(SuchWertZelle).Value)
Set Suche = ThisWorkbook.Worksheets("Tabelle1").Range(Cells(SuchZeileVon, SuchSpalte), _
Cells(SuchZeileBis, SuchSpalte)).Find(SuchNummer, LookIn:=xlValues)

If Suche Is Nothing Then
MsgBox "Nichts gefunden!", , "Suche nach: " & CStr(SuchNummer)
'Else
' MsgBox "Gefunden in " & Chr((Suche.Column Mod 26) + 64) & CStr(Suche.Row) & ".", , _
' "Suche nach: " & CStr(SuchNummer)
End If

End Sub

MfG Charlotte

Answer 3

Hi Dominik,

wenn der Suchbegriff nur einmalig in Spalte A vorkommt, geht es auch auf diese Weise:

Sub Suche()
Dim loZeile As Long
On Error Resume Next
loZeile = Application.Match(Worksheets("Hallo").Range("A1"), Worksheets("Hauptdatei").Columns("A"), 0)
On Error GoTo 0
If loZeile = 0 Then
MsgBox "Nr nicht vorhanden ... Neu anlegen"
End If
End Sub

Bis später,
Karin

Answer 4

Deins funktioniert wie die anderen auch ... BESTENS...

Ich habe jetzt folgenden Gesamtcode


Sub Kundennummer_in_Hauptdatei_hinzufügen()

Dim loZeile As Long
On Error Resume Next
loZeile = Application.Match(Worksheets("Kundennummer neu").Range("B4"), Worksheets("Kundenstamm").Columns("A"), 0)
On Error GoTo 0
If loZeile = 0 Then
MsgBox "Diese Kundennummer ist im Kundenstamm nicht mit Daten hinterlegt, sodass keine allgemeinen Kundendaten erscheinen. Bitte legen Sie einen neuen Kundensatz an im Kundenstamm oder aktualisieren Sie den gesamten Kundenstamm!"
End If


Dim lngFirstRow As Long
Application.ScreenUpdating = False
'erste freie Zelle in Blatt "Hauptdatei" ermitteln
lngFirstRow = Sheets("Hauptdatei").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'Wert aus Blatt "Kundennummer" Zelle B4 kopieren...
Sheets("Kundennummer neu").Range("B4").Copy
'und in Blatt "Hauptdatei" erste freie Zelle Spalte A einfügen
Sheets("Hauptdatei").Range("A" & lngFirstRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
MsgBox "Eintrag erfolgreich hinzugefügt", vbInformation, "Meldung..."
End Sub



EINE KLEINE FRAGE NOCH:

Was muss ich hinzufügen an "Befehlen", dass wenn der nach der Ausführung des ersten Befehls bei (Miss)Erfolg nicht mehr den zweiten Teil durchführt?? Also wenn er nix findet soll er den zweiten Teil ignorieren.

Answer 5

Hi Dominik,

mal ungetestet:

Sub Kundennummer_in_Hauptdatei_hinzufügen()
Dim lngFirstRow As Long
Dim loZeile As Long
On Error Resume Next
loZeile = Application.Match(Worksheets("Kundennummer neu").Range("B4"), Worksheets("Kundenstamm").Columns("A"), 0)
On Error GoTo 0
If loZeile = 0 Then
MsgBox "Diese Kundennummer ist im Kundenstamm nicht mit Daten hinterlegt, sodass keine allgemeinen Kundendaten erscheinen. Bitte legen Sie einen neuen Kundensatz an im Kundenstamm oder aktualisieren Sie den gesamten Kundenstamm!"
Else
Application.ScreenUpdating = False
'erste freie Zelle in Blatt "Hauptdatei" ermitteln
lngFirstRow = Sheets("Hauptdatei").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'Wert aus Blatt "Kundennummer" Zelle B4 kopieren...
Sheets("Kundennummer neu").Range("B4").Copy
'und in Blatt "Hauptdatei" erste freie Zelle Spalte A einfügen
Sheets("Hauptdatei").Range("A" & lngFirstRow).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
MsgBox "Eintrag erfolgreich hinzugefügt", vbInformation, "Meldung..."
End If
End Sub

Bis später,
Karin

Answer 6

funktioniert leider nicht...

da müsste irgendeine "ausschlussklausel" rein, dass sobald die meldung erscheint er den rest nicht mehr ausgibt. aber kp wie die heißen soll

Answer 7

TSchuldige...

Danke für den Code er funktioniert.
Super!!

Schönen Abend noch