aximand
Goto Top

Excel Worksheet Change - Wertänderung nicht wie gewünscht

Saluti,

ich such mir seid Stunden einen Kipparsch, schaue mir Tutorials an und frickel mir nen Wolf für eine Aufgabe, komme aber nie ganz ans Ziel und schaffe es, dass Excel immer wieder abschmiert.
Grundsätzlich möchte ich erreichen, dass andere Felder sich selbst füllen, wenn in einem Feld was eingegeben wird oder aus einer DropDown-Liste ein Wert gewählt wird.
Ziel ist es für ein ERP-System eine Importliste bereit zu stellen.

Teil 1:
Das ist jetzt nur ein Brot&Butter Teilaspekt:
Beim Aktivieren des Tabellenblattes soll der Anwender die Möglichkeit haben, in den Zellen einer Spalte Werte aus einer Dropdown-Liste einzugeben, was auch grundsätzlich gut klappt.

Private Sub Worksheet_Activate()
Dim Spalte1 As Range 
Set Spalte1 = Cells.EntireColumn(1)
With Spalte1.Validation '  
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="=Schlüssel!$b$6:$b$11"  
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""  
    .ErrorTitle = ""  
    .InputMessage = ""  
    .ErrorMessage = ""  
    .ShowInput = False
    .ShowError = False
End With

Teil 2:
Wenn nun im Tabellenblatt in der Zelle ein Wert ausgewählt wurde, soll irgendwas in einer anderen Spalte, gleiche Zeile passieren - z.B. ein weiteres Auswertungskennzeichen setzen. Und der eigentliche Zelleninhalt zoll gekürzt werden.
Im Dropdownfeld gibt es z.B.:
100 Verkauf
200 Rohstoff
Also die Bezeichnung für den numerischen 3stelligen Schlüssel ist mit im Dropdown enthalten.
Es sollen aber nur die ersten 3 Stellen nach der Auswahl in der Zelle verbleiben, da die 100 oder 200 interessant sein wird.

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Bereich As Range
 Set Bereich = ActiveCell.Cells

 ' Bereich.Value = "100 Verkauf oder 200 Rohstoff aus dem Dropdown"  
 
 If Left(Bereich.Value, 3) = "100" Then  
 Tabelle1.Cells(ActiveCell.Row, 72).Value = "A"  
 MsgBox Left(Bereich.Value, 3)
 Bereich.Value = Left(Bereich.Value, 3)
 End If

1 ist klar, ich will auf eine Änderung im Tabellenblatt reagieren
2 Ich brauche einen Platzhalter für den Zellenbereich
3 Ich weise dem Range-Objekt die aktuelle Zelle in der Cursor steht zu, so hoffe ich face-smile
7 Wenn die ersten 3 Zeichen des Bereichs-Wertes (100 Rohstoff) = 100 sind dann
8 schreib in die Tabelle1.Cells(die Zeile in der mein Cursor steht, Spalte 72) den Wert "A"
Bis dahin funktioniert das
9 Die MessageBox (als Test eingebaut) kommt schon gar nicht mehr hoch und 7 wird auch ignoriert.
10 Der Wert meines Range-Objektes "Bereich", der Value = "100 Rohstoff" hat soll nun die ersten 3 Zeichen erhalten und sich selbst überschreiben

Wo liegt mein Denkfehler? Wie erreiche ich mein Ziel? Im Hinterkopf behalten muss ich, dass es n Dropdown-Felder gibt die dann vielleicht im selben Tabellenblatt eine andere Zelle befüllen,
oder in einer Zelle eine Artikelbezeichnung bis 40 Zeichen eingetragen wird und dann automatisch in einer anderen Zelle nur die ersten 8 Zeichen der Artikelbezeichnung als Suchfeld eingetragen werden sollen.

Bitte keine Frage warum man eine Artikelbezeichnung mit 40 Zeichen hat und dann ein weiteres Feld für die Matchcodesuche mit 8 Zeichen benötigt, das ist halt in dem ERP-System so face-sad
Schreibfehler bitte ich zu entschuldigen, ich hab jetzt um 00:20 so langsam die Nase voll und bin frustriert ^^

Lieben Dank für geduldige Erklärung und Hilfe!

Content-Key: 568037

Url: https://administrator.de/contentid/568037

Printed on: May 21, 2024 at 10:05 o'clock

Member: emeriks
emeriks Apr 28, 2020 updated at 06:28:03 (UTC)
Goto Top
Hi,
Du hast einen Zirkel im Code.
Zeile 8 löst diese Event-Sub ebenfalls aus!

Du solltest als erstes prüfen, ob die geänderte Range für diese Sub überhaupt relevant ist, und nur dann fortsetzen. Bzw. solltest Du "Target" benutzen und nicht "ActiveCell.Cells".

Also in etwa
Private Sub Worksheet_Change(ByVal Target As Range)
 If not (Target(1).Row = GewünschteZeile and Target(1).Column = GewünschteSpalte) then
  exit sub
End if
 Dim Bereich As Range
 Set Bereich = ActiveCell.Cells

 ' Bereich.Value = "100 Verkauf oder 200 Rohstoff aus dem Dropdown"  
 
 If Left(Bereich.Value, 3) = "100" Then  
 Tabelle1.Cells(ActiveCell.Row, 72).Value = "A"  
 MsgBox Left(Bereich.Value, 3)
 Bereich.Value = Left(Bereich.Value, 3)
 End If
End Sub

E.
Mitglied: 143728
143728 Apr 28, 2020 updated at 14:15:12 (UTC)
Goto Top
Ich würde es so machen, Kommentare stehen im Quelltext
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Errhandler
    Dim cell As Range, strTargetValue as String
    'Range bei dem eine Änderung im Sheet das Event auslöst  
    Set rngChange = Range("A:A")  
    ' Nur bei Änderungen im definierten Range  
    If Not Application.Intersect(rngChange, Target) Is Nothing Then
        ' Eventhandler kurzeitig deaktivieren, sonst triggert die Änderung der selben Zelle erneut das Event.  
        Application.EnableEvents = False
        ' Für jede Zelle die geändert wurde  
        For Each cell In Target
            ' Wenn der Zellwert nicht leer ist  
            If cell.Value <> "" Then  
                ' extrahiere den gewünschten Wert aus der Zelle  
                strVal = Split(cell.Value, " ", 2, 1)(0)  
                ' setze diesen in die Zelle  
                cell.Value = strVal
                ' setze den Wert einer Variablen je nach Wert der aktuellen Zelle  
                Select Case strVal
                    Case "100"  
                        strTargetValue = "A"  
                    Case "200"  
                        strTargetValue = "B"  
                    Case "300"  
                        strTargetValue = "C"  
                End Select
                ' Setze diesen Wert in eine andere Spalte aber der selben Zeile wie die geänderte Zelle  
                Cells(cell.Row, 72).Value = strTargetValue
            End If
        Next
        ' Aktiviere die Eventhandler wieder  
        Application.EnableEvents = True
    End If
   
    Exit Sub
Errhandler:
    Application.EnableEvents = True
    MsgBox "Error: " & Err.Description  
End Sub