Login

**Rabe** · 05.12.2016, 18:06

Hallo,

ich habe 3 Datengültigkeiten:

Eingabe_ELC

	B	C	D	E	F	G	H	I
6	Anlaß	Neugerät
7	Serie	a	Gerät	a1			48	#NV

verbundene Zellen

E7:F7

verwendete Formeln
Zelle	Formel	Bereich	N/A
I7	=SVERWEIS($E$7;Listen!P3:R69;2;0)

Daten, Gültigkeit
Zelle	Zulassen	Daten	Wert1	Wert2	Leere Zellen ignorieren	Zellendropdown	Titel Eingabemeldung	Eingabemeldung	Titel Fehler	Fehlermeldung	Typ Fehlermeldung
C6	Liste		Neugerät;Änderung		Wahr	Wahr					Stopp
C7	Liste		=Listen!$C$2:$C$10		Wahr	Wahr					Stopp
E7:F7	Liste		=INDEX(Listen!$E$2:$M$20;;VERGLEICH($C$7;Listen!$E$1:$M$1;))		Wahr	Wahr					Stopp

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 19.08 einschl. 64 Bit

Wunsch-Aktionen:

Bei Änderung der Zelle C6 sollen C7 und E7 (sowie noch viele weitere, im Formular blau, z.B. I7) geleert werden.
Wenn in C6 "Neugerät" ausgewählt wird, soll in E7 und den Folgezellen beliebiger Text eingetragen werden können (also Gültigkeit E7 und alle SVERWEISe weg)
Wenn in C6 "Änderung" ausgewählt wird, soll in C7 und in E7 die Gültigkeit stehen.
Wenn ich nur in C7 eine Änderung der Familie mache, sollen außer C6 und C7 alle anderen Felder (z.B. I7) geleert werden.
Wenn in E7 etwas ausgewählt wird, soll in den Folgezellen das Ergebnis der SVERWEIS-Formel in Abhängigkeit von E7 stehen.

Wie kann ich diese Funktionalität in VBA abbilden?
Ich komme auf keinen grünen Zweig, da immer der Else-Strang mit der Erstellung der Gültigkeit oder dann der Zugriff mit SVERWEIS mit Laufzeitfehler quitiert wird.
Zur Reproduzierbarkeit:
auswählen von "Neugerät" in C6 => Laufzeitfehler
auswählen von "Änderung" in C6 => Laufzeitfehler
neuer Wert in C7 ...

Wie kann ich den Bereich der Folgezellen auf ein Mal leeren, mit dem aktuellen Code dauert es etwas.

snb · 05.12.2016, 19:44

Bitte: verzichte auf 'merged cells' !

**Rabe** · Registriert seit: 10.04.2014 Version(en): 2016 + 365

Hallo,

(05.12.2016, 19:44)snb schrieb: Bitte: verzichte auf 'merged cells' !

ok, dann hier ohne:

.xlsb

Muster-Dropdowns.xlsb (Größe: 27,94 KB / Downloads: 4)

Die Maske ist sowohl zur Eingabe, als auch zur Überprüfung vorgesehen.
Die Frage war eben, wie kann ich größere Texte lesbar in nur eine kleine Zelle unterbringen, darum sind sie verbunden. Direkt nebeneinander liegende blaue Zellen gehören zusammen.

**Rabe** · 07.12.2016, 18:12

nochmal nach oben holen, mit der Bitte um Hilfe!

***schauan*** · 07.12.2016, 21:50

Hallo Ralf,

erst mal zur Ausführung des Change-Ereignisses. Du änderst in Deinem Code ja noch eine Reihe weiterer Zellen, sodass der Code mehrfach durchlaufen wird. Wenn Du z.B. Neugerät wählst, wird E7 auf "" geändert - Nix durch Nix ersetzen ist auch eine Änderung - das Makro wird nochmals durchlaufen, Target ist E7, und entsprechend läuft das Makro in Dein VLOOKUP mit einer leeren Zelle E7 ... Tja, und das Makro wird ja bei jeder Zelländerung durchlaufen und da ist nicht nur die eine drin.

Nimm am Anfang Application.EnableEvents = False und am Ende wieder ... True.

**Rabe** · Registriert seit: 10.04.2014 Version(en): 2016 + 365

Hi,

(07.12.2016, 21:50)schauan schrieb: Nimm am Anfang Application.EnableEvents = False und am Ende wieder ... True.

ich hatte es schon versucht, mit False die Änderung zu verhindern. Dann kam aber trotzdem immer der Laufzeitfehler, wenn ich manuell C7 geändert habe, beim Erstellen der Gültigkeit.

Ich habe es nun so gelöst, daß ich bei Neugerät die Gültigkeit entferne und bei "Änderung" die Gültigkeit von einer Hilfszelle durch kopieren wieder in der Zelle installiere.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngLösch As Range
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  
  'On Error Resume Next 
  If Not Intersect(Target, Range("C6")) Is Nothing Then
     Union(Range("C8:C24"), Range("E8:E24"), Range("G8:G18"), Range("G19"), Range("G21"), Range("G23:G24"), _
         Range("I6:I15"), Range("I16"), Range("I18:I20"), Range("I23:I24"), Range("K6:K15"), Range("K17:K24")) = ""
     Range("C7") = ""
     Range("E7") = ""
     
     If Range("C6") = "Neugerät" Then
        Range("E7").Validation.Delete
     Else             'Änderung 
        Range("N7:P7").Copy Range("E7:G7")        'Gültigkeit durch kopieren wiederherstellen 
'         With Range("E7").Validation 
'            .Delete 
'            ' hier kommt ein Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler 
'            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
'                xlBetween, Formula1:="=INDEX(Listen!$E$2:$M$20;;VERGLEICH($C$7;Listen!$E$1:$M$1;))" 
'            'und die Gültigkeit wird nicht eingetragen 
'            .IgnoreBlank = True 
'            .InCellDropdown = True 
'            .InputTitle = "" 
'            .ErrorTitle = "" 
'            .InputMessage = "" 
'            .ErrorMessage = "" 
'            .ShowInput = True 
'            .ShowError = True 
'         End With 
        On Error GoTo Fehler
     End If
  End If
  
  If Not Intersect(Target, Range("C7")) Is Nothing Then
     If Range("C6") = "Neugerät" Then
        Range("N7:P7").ClearContents
        Union(Range("C8:C24"), Range("E8:E24"), Range("G8:G18"), Range("G19"), Range("G21"), Range("G23:G24"), _
            Range("I6:I15"), Range("I16"), Range("I18:I20"), Range("I23:I24"), Range("K6:K15"), Range("K17:K24")) = ""
        
     Else
        Range("N7:P7").Copy Range("E7:G7")
        Union(Range("C8:C24"), Range("E8:E24"), Range("G8:G18"), Range("G19"), Range("G21"), Range("G23:G24"), _
            Range("I6:I15"), Range("I16"), Range("I18:I20"), Range("I23:I24"), Range("K6:K15"), Range("K17:K24")) = ""
     End If
  End If
  
  If Not Intersect(Target, Range("E7")) Is Nothing And Range("C6") = "Änderung" Then
     Call SVERWEIS_eintragen
'      With Worksheets("Eingabe_ELC") 
'         'Formel eintragen 
'         '.Range("I7").FormulaR1C1 = "=VLOOKUP(RC[-4],Typ_Nr,3,0)" 
'         '.Range("K7").FormulaR1C1 = "=VLOOKUP(RC[-6],Typ_Nr,2,0)" 
'         'Werte eintragen 
'         .Range("I7").Value = WorksheetFunction.VLookup(.Range("E7"), Worksheets("Listen").Range("P3:R69"), 3, 0) 
'         .Range("K7").Value = WorksheetFunction.VLookup(.Range("E7"), Worksheets("Listen").Range("P3:R69"), 2, 0) 
'      End With 
  End If
  
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  Exit Sub
  
Fehler:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
  
  MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
      & "Beschreibung: " & Err.Description _
      , vbCritical, "Fehler"
  
End Sub

***schauan*** · 08.12.2016, 21:31

Hallo Ralf,

so weit war ich noch gar nicht Sad

Das .Add sollte so gehen, macht es jedenfalls bei mir:

Code:
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:= _
        "=INDEX(Listen!$E$2:$M$20,,MATCH($C$7,Listen!$E$1:$M$1,))"

**Rabe** · 09.12.2016, 11:11

Hi André,

(08.12.2016, 21:31)schauan schrieb: Das .Add sollte so gehen, macht es jedenfalls bei mir:

bei mir nicht, die Add-Zeile ist gelb:

Vorgehen:
zuerst bei C6 das Neugerät auswählen, dann Änderung oder nur Änderung.
Egal ob mit MATCH oder VERGLEICH.

***schauan*** · 09.12.2016, 15:16

Hallo Ralf,

das ist sehr mysteriös Sad

Für die genaue Syntax der Formel kannst Du übrigens selbige in eine Zelle eintragen, z.B. E6, und sie Dir dann mit
debug.print Cells(6,5).Formula
ausgeben lassen. Eventuell steht da bei Dir was anderes?

Ein Problem könnte auch sein, wenn die Formel beim Erzeugen einen Fehler, z.B. #NV bringt. Das könnte z.B. je nach Inhalt von C7 passieren.

**Rabe** · 09.12.2016, 15:23

Hi,

(09.12.2016, 15:16)schauan schrieb: Ein Problem könnte auch sein, wenn die Formel beim Erzeugen einen Fehler, z.B. #NV bringt. Das könnte z.B. je nach Inhalt von C7 passieren.

ich vermute, das ist es.
Am Anfang steht da ja in C7 noch nix drin. Mal schauen, wie ich das umgehen kann und ob es überhaupt nötig ist.

Login
Benutzername:
Passwort:	Passwort vergessen?
	Merken