Xooo Creative Commons License 2011.07.22 0 0 15522

Szia !

 

Köszönöm a segítséget, közben 3.5 órás guglizással sikerült megoldani a problémát. Az volt a baj a legördülő listákkal, hogy bármit kiválasztottál nem az jelent meg, hanem visszaugrott a lista elejére, ugyanis a makró az egész munkafüzetre érvényes volt és így szöveget sem lehetett beírni sehova és a listák sem működtek. A megoldás ez lett:

 

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim OldVal As Variant, NewVal As Variant
If Union(Range("$F3:$F100"), Target).Address = Range("$F3:$F100").Address Then
Application.EnableEvents = False
    NewVal = Target.Value
    Application.Undo
    OldVal = Target.Value
     If IsNumeric(OldVal) And IsNumeric(NewVal) Then
       Target.Offset(0, 1).Value = NewVal + Target.Offset(0, 1).Value
    End If
    Target.Value = NewVal
  Application.EnableEvents = True
  End If
  If Union(Range("$M3:$M100"), Target).Address = Range("$M3:$M100").Address Then
Application.EnableEvents = False
    NewVal = Target.Value
    Application.Undo
    OldVal = Target.Value
     If IsNumeric(OldVal) And IsNumeric(NewVal) Then
       Target.Offset(0, 1).Value = NewVal + Target.Offset(0, 1).Value
    End If
    Target.Value = NewVal
  Application.EnableEvents = True
  End If

End Sub

 

Így a beviteli cella mellett lévő cellába adja össze a számokat és a beviteli cellában mindig látszik az utolsó érték.

Igaz hogy mire rájöttem kifolyt mindkét szemem, de működik. Köszönöm szépen a segítségedet :)

Előzmény: Sznida (15517)