Inhalt einer Zelle vergleichen mit einer Liste

Question

Hallo,

ich bräuchte nen VBA code für Exel wie ich aus einer mappe1 mit
tabelle1 eine Zelle auslesen kann und deren Inhalt vergleiche mit
mappe2 tabelle2, Bereich A5:A30.

Wenn gewünschte Zeile gefunden wird soll diese dann meine neue Zeile
sein mit der ich arbeiten kann.

Ich habe hier bereits einen Code gefunden der nicht schlecht ist,
allerdings bleibt dieser nicht an der Stelle wo er die Zelle gefunden hat:


Private Sub Vergleich

Dim Zeile As Integer
Dim ErrNr As Integer

Zeile = 1
ErrNr = 0

Do While Cells(Zeile, 1).Value <> ""

If Range("B1").Value = Cells(k, 1).Value Then

ErrNr = ErrNr + 1
End If
Zeile = Zeile + 1
Loop

If ErrNr = 0 Then
MsgBox "Wert nicht in Liste enthalten", vbCritical, "Fehler"
Exit Sub
End If
'anderer Code
End Sub



Hat jemand eine Idee?

Answer 1

Hallo,

ich würde das so lösen:

Sub vergleich()

Dim gefunden As Boolean
Dim suchzelle As Range
Dim zeile As Long

For Each suchzelle In Range("A5:A30")
If suchzelle.Value = Range("B1").Value Then
gefunden = True
zeile = suchzelle.Row
Exit For
End If
Next

If gefunden = True Then
MsgBox "Der Begriff wurde in Zeile " & zeile & " gefunden!", 64, "Suchbegriff gefunden!"
Else
MsgBox "Der Begriff wurde nicht gefunden!", 16, "Fehler"
End If

End Sub

Gruß

M.O.

Answer 2

Super, merci!

leider schaffe ich es nicht den code in meinen einzufügen, bzw. irgendwas mache ich falsch.

Die Sache ist das ich nicht nur die Zellen vergleichen will sondern wenn die Zeile gefunden wird
dann soll diese ersetzt werden durch eine andere.

debugger sagt nichts an, aber Excel macht nicht das was ich möchte. Jemand eine Idee?


Hier mal mein Code:




Public Sub Import_xlph()

Dim vntZuOeffnendeDatei As Variant
Dim wksZielBlatt As Worksheet

Dim gefunden As Boolean
Dim suchzelle As Range
Dim zeile As Long

'zeile = 4

'pop-up Fenster zum auswählen der Quelldatei.
vntZuOeffnendeDatei = Application.GetOpenFilename("Excel Dateien (*.xls*), *.xls*")

If vntZuOeffnendeDatei = False Then Exit Sub

Application.ScreenUpdating = False

'Hier wird die Zieltabelle initialisiert.
Set wksZielBlatt = ThisWorkbook.Worksheets("Ziel")

With Workbooks.Open(vntZuOeffnendeDatei, 0, True)

'Hier wird die Quelltabelle übergeben.
With .Worksheets("Quelle")

For Each suchzelle In Range("A5:A30")
If suchzelle.Value = Range("A4").Value Then
gefunden = True
zeile = suchzelle.Row
Exit For
End If
Next

If gefunden = True Then

'Hier wird der zu kopierende Bereich definiert.
.Range("A4:AP4" & CStr(zeile)).Copy
wksZielBlatt.Cells(wksZielBlatt.Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
xlPasteValues
Application.CutCopyMode = False

End If

Set wksZielBlatt = Nothing

End With
End With
End Sub

Answer 3

Hallo,

in deinem Code steht:

.Range("A4:AP4" & CStr(zeile)).Copy

Falls der Suchbegriff in Zeile 2 gefunden wird, kopierst du also den Bereich A4:A42.
Das ist doch wohl nicht so gewollt.
Wenn ich dich richtig verstanden habe, dann müsste die Zeile so lauten:

Range("A" & zeile & " :AP" & zeile).Copy

Aber erläutere doch bitte mal zur Klarstellung:
In welcher Mappe ist die Zelle A4?
In welcher Mappe ist der Suchbereich?
Und in welche Mappe soll dann die gefundene Zeile eingefügt werden?

Gruß

M.O.

Answer 4

Also:

Mappe1/Tabelle1/A4 ist die Zelle mit der ID.

Mappe2/Tabelle2/A5:20 ist der Bereich wo die ID gesucht werden soll.

Wenn ID gefunden dann soll die gesamte Zeile von Mappe1/Tabelle1 kopiert werden und an der Stelle wo die ID gefunden wurde eingefügt werden.

Answer 5

Hallo,

hier mal ein geändertes Makro. Kopiere den Code in ein allgemeines Modul deiner Zieldatei. Die Namen der Tabellenblätter musst du ggf. anpassen.

Public Sub Import_xlph()

Dim vntZuOeffnendeDatei As Variant
Dim Quelle As String
Dim gefunden As Boolean
Dim suchzelle As Range

'pop-up Fenster zum auswählen der Quelldatei.
vntZuOeffnendeDatei = Application.GetOpenFilename("Excel Dateien (*.xls*), *.xls*")

If vntZuOeffnendeDatei = False Then Exit Sub

Application.ScreenUpdating = False

'Name der Quelle in Variable schreiben
With Workbooks.Open(vntZuOeffnendeDatei, 0, True)
Quelle = .Name
End With

'Suchen
With ThisWorkbook.Worksheets("Ziel")

For Each suchzelle In .Range("A5:A30")
If suchzelle.Value = Workbooks(Quelle).Worksheets("Quelle").Range("A4").Value Then
'Quelledaten kopieren
Workbooks(Quelle).Worksheets("Quelle").Range("A4").EntireRow.Copy
'und einfügen
.Cells(suchzelle.Row, 1).PasteSpecial Paste:=xlPasteValues 'nur Werte einfügen
'Auswahl aufheben
Application.CutCopyMode = False
gefunden = True
Exit For
End If
Next
End With

'Quelldatei wieder schließen
Workbooks(Quelle).Close (False)

ThisWorkbook.ActiveSheet.Cells(ActiveCell.Row, 1).Select

Application.ScreenUpdating = False

If gefunden = False Then
MsgBox "Der Begriff wurde nicht gefunden!", 16, "Fehler"
End If

End Sub

Gruß

M.O.

Answer 6

Hammer es funktioniert!!!

ich weiß nicht ob es am Netzwerk liegt aber leider braucht er ein wenig dafür... kann man das irgendwie beschleunigen?

Ach noch eine wichtige Frage, kann man in den code noch eine message Box einbauen welche mir sagt was für daten überschrieben werden?

Wenn in der alten Zeile z.b. in B5 ein altes Datum drinnen steht dass mir eine Box dann ausgibt dass dieses Datum mit einem anderen Wert überschrieben wird und beide Inhalte sozusagen anzeigt?

Vielleicht sogar eine Dialogbox welche ein OK oder ein Abbruch verlangt um so auch keine Daten zu verlieren?

Das wäre noch das non-plus Ultra wenn das gehen würde :)

Answer 7

Hallo,

warum das bei dir so langsam geht, kann ich leider nicht sagen. Bei meinen Tests läuft das Makro zügig durch. Du kannst die zu öffnende Datei ja mal auf deinen Rechner kopieren und dann probieren.

Hier das Makro mit Abfrage:

Public Sub Import_xlph()

Dim vntZuOeffnendeDatei As Variant
Dim Quelle As String
Dim gefunden As Boolean
Dim suchzelle As Range
Dim rueckgabe

'pop-up Fenster zum auswählen der Quelldatei.
vntZuOeffnendeDatei = Application.GetOpenFilename("Excel Dateien (*.xls*), *.xls*")

If vntZuOeffnendeDatei = False Then Exit Sub

Application.ScreenUpdating = False

'Name der Quelle in Variable schreiben
With Workbooks.Open(vntZuOeffnendeDatei, 0, True)
Quelle = .Name
End With

'Suchen
With ThisWorkbook.Worksheets("Ziel")

For Each suchzelle In .Range("A5:A30")
If suchzelle.Value = Workbooks(Quelle).Worksheets("Quelle").Range("A4").Value Then
'Nachfrage
rueckgabe = MsgBox("Es wurde ein Datensatz mit Datum vom " & .Cells(suchzelle.Row, 2).Value & " gefunden!" & vbLf & "Soll dieser mit dem Datensatz vom " & Workbooks(Quelle).Worksheets("Quelle").Range("B4") & " überschrieben werden?", 36, "Überschreiben bestätigen")

If rueckgabe = vbYes Then
'Quelledaten kopieren
Workbooks(Quelle).Worksheets("Quelle").Range("A4").EntireRow.Copy
'und einfügen
.Cells(suchzelle.Row, 1).PasteSpecial Paste:=xlPasteValues 'nur Werte einfügen
'Auswahl aufheben
Application.CutCopyMode = False
'Quelldatei wieder schließen
Workbooks(Quelle).Close (False)
gefunden = True
Exit For
Else
'Quelldatei wieder schließen
Workbooks(Quelle).Close (False)
Exit Sub
End If
End If
Next
End With

ThisWorkbook.ActiveSheet.Cells(ActiveCell.Row, 1).Select

Application.ScreenUpdating = False

If gefunden = False Then
MsgBox "Der Begriff wurde nicht gefunden!", 16, "Fehler"
End If

End Sub

Gruß

M.O.

Answer 8

Hi all,

ich gehe mal davon aus das Mappe1 deine Quellmappe und Mappe2 deine Zielmappe sein soll. Hier mal ein paar Tipps:

soweit ich das beurteilen kann, vergleicht dein Code Zelle A4 der Quellmappe mit Zellbereich A5:A30 der Quellmappe. Gemäß Antwort 4 willst du aber mit A5:A30 der Zielmappe vergleichen. Ersetze hierzu die ersten beiden Zeilen deiner Schleife durch

For Each suchzelle In wksZielBlatt.Range("A5:A30")
If suchzelle.Value = .Range("A4").Value Then

Außerdem fügt dein Code die Zeile nicht an der Stelle, wo ID gefunden wurde ein, sondern immer unterhalb der jeweils letzten Zeile der Tabelle. Das widerspricht Antwort 4. Wenn du genau an der Stelle einfügen willst, sollte deine Einfügezeile lauten:

wksZielBlatt.Cells(4+zeile, 1).PasteSpecial xlPasteValues

sowie deine Kopierzeile: .Range("A4:AP4").Copy

Allerdings habe auch ich noch nicht so ganz verstanden wie du dann weiterarbeiten willst. Nutzt du den Code in Schleife und vergleichst als nächstes Zeile 5 der Quelldatei? In diesem Fall solltest du die Variable zeile zu Beginn deines Codes in Quellzeile umbenennen damit sie nicht mit der gefundenen zeile im Zielblatt korreliert.

Gruß Mr. K.

Answer 9

uups,

da war der Thread inzwischen weitergelaufen. Somit meine Anwort veraltet. Bitte ignorieren!

Answer 10

Danke! :)

wie müsste ich denn die MessageBox umschreiben dass er mir die Komplette Zeile ausgibt, genauso wie die überschrift Zeile und die die Zeile mit den neuen Werten?

Überschriften wären quasi A3:AP3
alte daten A4:AP4

und die neuen Daten von der anderen Tabelle ebenfalls A4:AP4

man sollte sie nur auf einer Seite alle zusammen sehen können, das wäre super.