mehrere zellen in zeile vergleichen

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim wb As Workbook: Set wb = ActiveWorkbook Dim ws As Worksheet: Set ws = wb.ActiveSheet Dim lrow As Integer lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row Dim frow As Integer frow = lrow - 1 Dim i As Integer 'lässt sich der folgende Komplex vereinfachen? For i = 2 To frow If ws.Cells(i, 1).Value = ws.Cells(lrow, 1) Then If ws.Cells(i, 2).Value = ws.Cells(lrow, 2) Then If ws.Cells(i, 3).Value = ws.Cells(lrow, 3) Then MsgBox "Gibt es bereits in Zeile: " & i ws.Cells(lrow, 1).Value = Empty ws.Cells(lrow, 2).Value = Empty ws.Cells(lrow, 3).Value = Empty ws.Cells(i, 1).Select GoTo weiter End If End If End If Next i weiter: 'weiterer Code... End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hey Ralf,
vielen Dank für deine Vorschläge, vor allem zu Intersect(), das macht die Aktivitäten etwas schlanker.
Ich habe die Arrays mit folgender Quelle versucht umzusetzen: https://www.herber.de/forum/archiv/1440to1444/1440636_Bereich_in_Array_einlesen.html?msclkid=2fb026c0cec111ec969f9da5fd7682fa
Ich nehme an, dass unten markiertes "Hier" den Bereich vergleicht. Leider passiert bei mir im Moment gar nichts. Was müsste ich ändern?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim lrow As Integer
lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim lcol As Integer
lcol = ws.Cells(1, 1).End(xlToRight).Column
Dim frow As Integer
frow = lrow - 1
If Not Intersect(Target, Range(ws.Cells(2, 1), ws.Cells(lrow, lcol))) Is Nothing Then
Dim myOrigin As Variant
Dim myTarget As Variant
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
Dim myOut As Variant
Dim L As Long
myOrigin = ws.Range(ws.Cells(2, 1), ws.Cells(frow, lcol))
myTarget = ws.Range(ws.Cells(lrow, 1), ws.Cells(lrow, 3))
ReDim myOut(1 To UBound(myTarget), 1 To UBound(myOrigin, 2) - 1) 'Frage 1: Was macht das?
For L = LBound(myOrigin) To UBound(myOrigin)
myDic(myOrigin(L, 1)) = WorksheetFunction.Index(myOrigin, L)
Next
'hier wird verglichen, oder? Bei folgendem Code wird jede Änderung bekannt gegeben. Aber es soll ja nur Bescheid geben, wenn die ersten drei Zellen stimmen
For L = LBound(myTarget) To UBound(myTarget)
If myDic.exists(myTarget(L, 1)) Then
MsgBox "Existiert"
End If
Next
'Wenn ich den Code aus der Quelle komplett übernehme passiert überhaupt nichts:
For L = LBound(myOrigin) To UBound(myOrigin)
myDic(myOrigin(L, 1)) = WorksheetFunction.Index(myOrigin, L)
Next
For L = LBound(myTarget) To UBound(myTarget)
If myDic.exists(myTarget(L, 1)) Then
myItem = myDic(myTarget(L, 1))
For lngIndex = 2 To UBound(myItem)
myOut(L, lngIndex - 1) = myItem(lngIndex)
Next
End If
Next
ws.Cells(1, 30).Resize(UBound(myOut), UBound(myOut, 2)) = myOut
End If
End Sub

Freue mich über jede Hilfe
Johannes

Redim kann man per STRG + F1 aus dem Codeeditor heraus in der Onlinehilfe recherchieren. Hier wird das Array in der Größe angepasst.
MyTarget ist nur 3 Spalten groß also geht die Schleife auch nur von 1 bis 3 . Aber es wird jeder Wert verglichen und nicht so wie du es haben möchtest die Kombi der drei Werte. Ich sehe gerade nicht wo die Abgrenzung stattfindet zwischen der Eingabe und dem anderen Bereich. Wenn die Eingabe mit im Prüfbereich drin ist, dann ist die auch immer schon mal vorhanden. Das Problem bei solchen Codes, die für eine spezielle Tabelle gebaut wurden, ist die Anpassung an eine andere spezielle Tabelle.
Mach doch mal ne Beispieltabelle fertig und beschreibe genau den Ablauf. Kann es vorkommen das mitten in der Tabelle etwas geändert wird?

Private Sub Worksheet_Change(ByVal Target As Range) Dim lrow As Integer: lrow = Cells(Rows.Count, 1).End(xlUp).Row Dim lcol As Integer: lcol = Cells(1, 1).End(xlToRight).Column If Not Intersect(Target, Range(Cells(2, 1), Cells(lrow, lcol))) Is Nothing Then Dim myOrigin As Variant Dim mySuche As String Dim L As Long myOrigin = ws.Range(ws.Cells(2, 1), ws.Cells(lrow, lcol)) 'frow eine Zeile oberhalb Eingabezeile mySuche = ws.Cells(Target.Row, 1) & "|" & _ ws.Cells(Target.Row, 2) & "|" & _ ws.Cells(Target.Row, 3) '3 werte zusammensetzen For L = LBound(myOrigin) To UBound(myOrigin) 'Schleife mit Anzahl der Prüfzeilen If Target.Row L + 1 Then 'Eingabe zeile auslassen If mySuche = myOrigin(L, 1) & "|" & myOrigin(L, 2) & "|" & myOrigin(L, 3) Then MsgBox "Gefunden: " & mySuche Exit For End If End If Next End If End Sub

Beliebteste Forumthreads (12 Monate)

mehrere zellen in zeile vergleichen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

46 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mehrere zellen in zeile vergleichen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

46 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread