Törölt nick Creative Commons License 2011.04.19 0 0 14640

Próbáld ki ezt. Feltételeztem, hogy a B oszlopban vannak az alma, cékla, banán, stb., szóval amivel beazonosítható a nemtudommi, továbbá a C oszlopban van nemtudomminek a nemtudommije, amit figyelni kell. Sajnos e tekintetben eléggé ellentmondásos információk jöttek eddig. Az alapötlet pedig az eddigiektől eltérően az, hogy a már naplózott banánok közül keresem ki az utolsó banánt, és ha ahhoz képest van eltérés, akkor naplózom megint. Így nem kell temp munkalap.


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsLog As Worksheet, rLog As Range
    Dim rQuery As Range, c As Range, Hit As Range
    
    Set wsLog = Worksheets("Munka5")
    Set rQuery = Range("B1", Range("B" & Rows.Count).End(xlUp))
    For Each c In rQuery
        Set rLog = wsLog.Range("B" & Rows.Count).End(xlUp).Offset(1)
        Set Hit = wsLog.Range("B:B").Find(what:=c.Value, after:=rLog, LookIn:=xlValues, lookat:=xlWhole, searchdirection:=xlPrevious)
        If Hit Is Nothing Then
            rLog.Offset(, -1).Resize(, 3).Value = c.Offset(, -1).Resize(, 3).Value
            rLog.Offset(, 2) = Now
        ElseIf Hit.Offset(, 1) <> c.Offset(, 1) Then
            rLog.Offset(, -1).Resize(, 3).Value = c.Offset(, -1).Resize(, 3).Value
            rLog.Offset(, 2) = Now
        End If
    Next
End Sub

Előzmény: pilota-kex (14637)