Microsoft Excel

Herbers Excel/VBA-Archiv

gelöschte Werte zwischenspeichern - VBA | Herbers Excel-Forum


Betrifft: gelöschte Werte zwischenspeichern - VBA von: Schorschi
Geschrieben am: 26.12.2009 17:16:22

Hallo Forum,

folgenden VBA-Code möchte ich gerne umstellen…

besitze aber nur sehr bescheidene VBA-Kenntnisse

Private Sub Worksheet_Change(ByVal Target As Range)

Dim RaBereich2222 As Range
Dim RaBereich3333 As Range

Set RaBereich2222 = Range("h2:h121")
Set RaBereich3333 = Range("i1:i121")

If Application.Intersect(Target, RaBereich2222) Is Nothing Then Exit Sub

Target.Offset(0, 1).Value = Application.WorksheetFunction.Max(RaBereich3333) + 2
End If

If IsEmpty(Target.Value) Then
Target.Offset(0, 1).Value = ""
End If

End Sub

Erklärung:

Der Startwert befindet sich in der Zelle i1 .
Im RaBereich2222 wird die Menge (Zahlen auch Buchstaben) nach Vergabe erfasst.
Im RaBereich3333 erfolgt automatisch die Vergabe einer Nummer, mit Step + 2 zum Maximalwert.

Die Liste der Namen (= Bereich links neben RaBereich2222) ist in Gruppen
festgelegt und darf nicht verändert werden.

Problem:

Wird nun nachträglich geändert oder storniert, so ändert der Worksheet_Change-Code
diese Nummer mit Step + 2 zum Maximalwert oder löscht sie automatisch.

Die gelöschte Nummer (außer beim letzten Vorgang) wird nicht wieder vergeben,
dies sollte aber nicht sein.

Vorstellung:

Erhalt der Nummer, sie soll beim geänderten Vorgang verbleiben,
und bei Storno an einen anderen, später eingehenden Vorgang vergeben werden.

Lösung: Zwischenspeicherung?? Mit späterem Abruf…..

Umsetzung: …?

Beispieldatei:

https://www.herber.de/bbs/user/66823.xls

Vielen Dank für alle Lösungsvorschläge!!

Wünsche noch einen schönen Feiertag und ein schönes Wochenende!

Gruß

Schorschi

  

Betrifft: AW: gelöschte Werte zwischenspeichern - VBA von: Josef Ehrensberger
Geschrieben am: 26.12.2009 22:47:02

Hallo Schorschi,

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim lngNextNumber, lngMax As Long, lngMin As Long
  Dim RaBereich2222 As Range
  Dim RaBereich3333 As Range
  
  Set RaBereich2222 = Range("h2:h121")
  Set RaBereich3333 = Range("i1:i121")
  
  If Intersect(Target, RaBereich2222) Is Nothing Then Exit Sub
  
  If IsEmpty(Target.Value) Then
    Target.Offset(0, 1) = ""
  Else
    
    With Application
      lngMin = Range("I1")
      lngMax = .Max(RaBereich3333) + 2
      For lngNextNumber = lngMin To lngMax Step 2
        If .CountIf(RaBereich3333, lngNextNumber) = 0 Then Exit For
      Next
      Target.Offset(0, 1) = lngNextNumber
    End With
  End If
  
  Set RaBereich2222 = Nothing
  Set RaBereich3333 = Nothing
End Sub




Gruß Sepp



  

Betrifft: super genial... Vielen Dank! von: Schorschi
Geschrieben am: 27.12.2009 08:58:09

Hallo Sepp,

vielen herzlichen Dank für die Hilfe und Lösung.

Es funktioniert perfekt!!

Ich wünsche Dir einen schönen Sonntag,
einen guten Rutsch und ALLES GUTE für das neue Jahr!!

Gruß
Schorschi


Beiträge aus den Excel-Beispielen zum Thema "gelöschte Werte zwischenspeichern - VBA"