Wert in Zelle bei Änderung in Liste eintragen

Hallo Forumsbesucher,
ich benötige noch einmal die Unterstützung aller VBA - Kenner.
Wie kann ich erreichen, dass der Zellwert in der Zelle J3 bei Änderung in die erste freie Zeile der Spalte C - beginnend jedoch erst ab Zeile 18 eingetragen wird und dies nur dann geschieht, wenn der gleiche Wert in der Spalte C ab Zeile 18 noch in keiner Zelle eingetragen ist.
Zur Verdeutlichung: In der Zelle J3 habe ich über eine Gültigkeitsprüfung geregelt, dass Eingaben entsprechend einer Liste möglich sind. Erfolgt nun ein erster Eintrag in J3 sollte dieser Zelleintrag in die Zelle C18 geschrieben werden. Beim nächsten Eintrag in J3 sollte dieser Zelleintrag - sofern nicht eben identisch mit dem vorherigen und deshalb in C18 enthaltenen Wert - dieser in die Zelle C19 geschrieben werden. In die Zelle C20 erfolgt dann der nächste Zelleintrag aus J3, sofern dieser nicht bereits in C18 oder C 19 steht.
Ich hoffe, das ich mein Anliegen für euch nachvollziehbar dargelegt habe und freue mich über jede Form von kompetenter Hilfe
mfg
Fritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) if target.address="$J$3" then theVal=target.value theRow=18 set theActRange = Range("C" & theRow) found=false do until theActRange.value="" or found found=(theActRange.value=theVal) theRow=theRow+1 set theActRange = Range("C" & theRow) loop if not found then theActRange.Value=theVal end if End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Cells(1, 3) = 1 And sngT = 0 Then sngT = Timer ElseIf Cells(1, 3) = 2 And sngT > 0 Then If lngZ < 18 Then lngZ = 18 Cells(lngZ, 10) = Application.Round(Timer - sngT, 1) lngZ = lngZ + 1 sngT = 0 ElseIf Target.Address = "$J$2" Then Range("J3").ClearContents If Target.Address = "$J$3" Then theVal = Target.Value theRow = 18 End If Application.EnableEvents = True End Sub

Hallo Fritz,
aufgrund der neuen Informationen müsste es mit folgender Methode (neuer Code und alter Code zusammengefügt, alle neuen Teile mit '********* .... dargestellt) klappen.
Viele Grüße
Wolfgang

Private Sub Worksheet_Change(ByVal Target As Range)
************** neue Variablendeklaration ---- > Start
Dim theVal as String, theActRange as Range, theRow as Integer, found as Boolean
************** neue Variablendeklaration ---- > Ende
Application.EnableEvents = False
If Cells(1, 3) = 1 And sngT = 0 Then
sngT = Timer
ElseIf Cells(1, 3) = 2 And sngT > 0 Then
If lngZ < 18 Then lngZ = 18
Cells(lngZ, 10) = Application.Round(Timer - sngT, 1)
lngZ = lngZ + 1
sngT = 0
ElseIf Target.Address = "$J$2" Then Range("J3").ClearContents
End If
Application.EnableEvents = True
************** neuer Code ---- > Start
if target.address="$J$3" then
theVal=target.value
theRow=18
set theActRange = Range("C" & theRow)
found=false
do until theActRange.value="" or found
found=(theActRange.value=theVal)
theRow=theRow+1
set theActRange = Range("C" & theRow)
loop
if not found then theActRange.Value=theVal
end if
************** neuer Code ---- > Ende
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) ************** neue Variablendeklaration ---- > Start Dim theVal as String, theActRange as Range, theRow as LONG, found as Boolean ************** neue Variablendeklaration ---- > Ende Application.EnableEvents = False If Cells(1, 3) = 1 And sngT = 0 Then sngT = Timer ElseIf Cells(1, 3) = 2 And sngT > 0 Then If lngZ < 18 Then lngZ = 18 Cells(lngZ, 10) = Application.Round(Timer - sngT, 1) lngZ = lngZ + 1 sngT = 0 ElseIf Target.Address = "$J$2" Then Range("J3").ClearContents End If Application.EnableEvents = True ************** neuer Code ---- > Start if target.address="$J$3" then theVal=target.value theRow=18 set theActRange = Range("C" & theRow) found=false do until theActRange.value="" or found found=(theActRange.value=theVal) theRow=theRow+1 set theActRange = Range("C" & theRow) loop if not found then theActRange.Value=theVal end if ************** neuer Code ---- > Ende End Sub

Beliebteste Forumthreads (12 Monate)

Wert in Zelle bei Änderung in Liste eintragen

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wert in Zelle bei Änderung in Liste eintragen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread