Nochmal: Eine Konstante in einem Protokoll ersetzt

Hallo an alle VBA Fans!
Ich hab mal wieder ein kleines Problem. Damit es ein wenig einfachen ist, habe ich einmal die Arbeitsmappe hochgeladen:

Die Datei https://www.herber.de/bbs/user/18302.xls wurde aus Datenschutzgründen gelöscht

Es handelt sich hierbei um ein Programm was Haus-zu-Haus-Verteilungen für unseren Gemeindebrief (kirchlich, also nicht kommerziell) organisieren kann.
Die Tabelle1 ist die Auszahlungsmaske, in die mittels Barcode die ausgegebenen Quittungen eingescannt werden. Es kann nun vorkommen, dass ein Verteiler auf einmal mehr Haushalte in seinem Bezirk hat als geplant (z.B. Neubaugebiet etc.) Bei der Auszahlung sollen diese mehr verteilten Hefte aber auch finaziell berücksichtig werden. Gebe ich nun in Zelle L10 einen Wert ein, egal ob größer oder kleiner, so wäre es gut wenn eine Msg-Box erscheinen würde, die Abfragt, ob die neue Haushaltsanzahl generell für den Bezirk übernommen werden soll oder nicht. Klickt man "JA" an, so müsste der Wert aus L10 in das Arbeitsblatt "Bezirksübersicht" und in das Arbeitsblatt "Historie" in die entsprechende Zeile kopiert werden. Clickt man auf "NEIN" soll lediglich der Wert in "Historie" kopiert werden. Um die entsprechende Zeile in Bezirksübersicht zu finden, kann am besten die Information des Bezirks verwendet werden (in Tabelle1, Zelle F9). Úm den Wert in "Historie" zu übernehmen, ist es wichtig, das ein anderer Indikator verwendet wird. Am besten wäre B12, da dieser wert in der gesamten Historie nur 1x vorkommen kann. Bezirk hingegen kann mehrfach vorkommen und ist deshalb bei Historie unbrauchbar.
Ich weiß, das ein solch komplexes Problem nicht leicht zu lösen ist. Ich würde mich jedoch sehr freuen, wenn mir einer helfen könnte.
Vielen Dank im Voraus.
Thorben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Thorben!
Tausch' den Code gegen diesen!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
'Nur wirksam bei Änderung in "L10"
   If Target.Address = "$L$10" Then
'Wenn L10 nich leer und <> F10, dann
      If[L10] <> "" And[L10] <>[F10] Then
'Frage
         If MsgBox("Haushaltsanzahl übernehmen?", vbYesNo + vbQuestion, _
                           "Frage") = vbYes Then
'Nummer aus F9 (replace()) in "Bezirksübersicht" suchen
            Set rng = Sheets("Bezirksübersicht").Range("A:A"). _
                        Find(what:=CDbl(Replace([F9].Text, ".Bezirk", "")), _
                        LookIn:=xlValues, LookAt:=xlWhole)
'Wenn gefunden, dann in entsprechende Zelle Wert aus L10 eintragen
               If Not rng Is Nothing Then
               rng.Offset(0, 3) =[L10]
               End If
         End If
'Nummer aus B12 in "Historie" suchen
            Set rng = Sheets("Historie").Range("V:V"). _
                        Find(what:=[B12].Text, _
                        LookIn:=xlValues, LookAt:=xlWhole)
'Wenn gefunden, dann in entsprechende Zelle Wert aus L10 eintragen
               If Not rng Is Nothing Then
               rng.Offset(0, 2) =[L10]
               End If

      End If

   End If
End Sub

Code eingefügt mit Syntaxhighlighter 3.0

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range 'Nur wirksam bei Änderung in "L10" If Target.Address = "$L$10" Then 'Wenn L10 nich leer und <> F10, dann If [L10] <> "" And [L10] <> [F10] Then 'Frage If MsgBox("Haushaltsanzahl übernehmen?", vbYesNo + vbQuestion, _ "Frage") = vbYes Then 'Nummer aus F9 (replace()) in "Bezirksübersicht" suchen Set rng = Sheets("Bezirksübersicht").Range("A:A"). _ Find(what:=CDbl(Replace([F9].Text, ".Bezirk", "")), _ LookIn:=xlValues, LookAt:=xlWhole) 'Wenn gefunden, dann in entsprechende Zelle Wert aus L10 eintragen If Not rng Is Nothing Then rng.Offset(0, 3) = [L10] End If End If 'Nummer aus B12 in "Historie" suchen Set rng = Sheets("Historie").Range("V:V"). _ Find(what:=[B12].Text, _ LookIn:=xlValues, LookAt:=xlWhole) 'Wenn gefunden, dann in entsprechende Zelle Wert aus L10 eintragen If Not rng Is Nothing Then rng.Offset(0, 2) = [L10] End If End If End If End Sub

Beliebteste Forumthreads (12 Monate)

Nochmal: Eine Konstante in einem Protokoll ersetzt

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread