Exel Formel und VBA Problem

[Jan Von]

Hallo Zusammen,

ich habe ein Problem und komme nicht weiter. Ich hoffe nun das Hier jemand Rat hat und wie ich es umsetzen kann.
Meine Exel-Datei benötigt viel Dropdowns und so wie es jetzt ist würde es enom ausarten.
Es gibt 20 Regale mit je 8 Artikel die hinterlegt werden sollen. Das würden 160 Dropdownlisten entsprechen.


Dazu habe ich eine Liste mit Artikel angelegt und weitere Dropdowns.


Hier mein Formel:

Code:

=WENNFEHLER(INDEX([Namen];AGGREGAT(15;6;(ZEILE([Namen])-1)/(--SUCHEN($B$2;[Namen])>0);ZEILE()-1);1);"")

In $B$2 ist ein Dropdown mit Filter. Hier würde ich gerne die aktive Zelle ansprechen.

Anbei habe ich mal die Mappe-Test angehängt.


Ich habe eine andere Herrangehensweise mittels VBA versucht, allerdings bekomme ich da ein Fehler.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'** Prüfen, ob der Wert in Zelle H2 geändert wurde
If Not Application.Intersect(Target, Range("H3:H10")) Is Nothing Then
 
  '** Screenupdating und Berechnung deaktivieren
  With Application
    .ScreenUpdating = False
   .Calculation = xlCalculationManual
  End With
 
  '** Dimensinionierung der Variablen
  Dim wsDat
  Dim lngZeile As Long
  Dim lngPos As Long
 
  '** Vorgaben definieren
  Set wsDat = ThisWorkbook.Sheets(1)
  lngZeile = 2 '** Startzeile für Ausgabe in Spalte C
 
  '** Ausgabebereich löschen
  wsDat.Range("C2:C50").ClearContents
 
  '** Spalte H ab Zeile 2 bis zur letzten gefüllten Zeile durchlaufen
  For a = 2 To wsDat.Cells(Rows.Count, 5).End(xlUp).Row
   
    '** Ermittlung der Position, ab der das gesuchte Zeichen aus Zelle C3 gefunden wurde
    lngPos = InStr(1, LCase(wsDat.Cells(a, 5).Value), LCase(wsDat.Range("H3").Value))
   
    '** Daten in Spalte C auflisten, wenn der Suchbegriff vorhanden ist
    If lngPos > 0 Then
      wsDat.Cells(lngZeile, 3).Value = wsDat.Cells(a, 5).Value
     
      '** Zeilenzähler erhöhen
      lngZeile = lngZeile + 1
    End If
   
  Next a

  '**Berechnung und Bildschirmaktualisierung wieder einschalten
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
  End With

End If

Diese Zeile macht mir zu schaffen:

Code:

lngPos = InStr(1, LCase(wsDat.Cells(a, 5).Value), LCase(wsDat.Range("H3").Value))

Ändere ich die Range auf H3:H10 bekomme ich ein Laufzeiten-Fehler.
Anbei habe ich mal die Mappe-Test-2 angehängt.


Weiß wer Rat.


Nachtrag: Diesen Forum habe ich auch eine Anfrage gestellt.
http://www.office-hilfe.com/support/show...ten-Fehler
und
http://www.office-hilfe.com/support/show...tive-Zelle

[steve1da]

Hola,

verlinkst du bitte deine Fragen in den verschiedenen Foren gegenseitig?
Danke.

https://www.clever-excel-forum.de/misc.php?action=help&hid=10

Gruß,
steve1da

[Jan Von]

Hola,

verlinkst du bitte deine Fragen in den verschiedenen Foren gegenseitig?
Danke.



Gruß,
steve1da

Was meinst du? Weil ich diese Frage in einem anderen Forum gestellt habe?

Wenn ja, eine Lösung ist mir sehr wichtig und ich versuche Hilfe zu bekommen und dafür möchte ich gerne alles möglich tun was ich kann.
2 Foren bedeuten für mich das ich mehr User erreiche.
Crossposting ist nicht meine Absicht!

Aber ich verstehe Dich voll und ganz!

Beste Grüße

[schauan]

Hallöchen,

mal ohne Deine Dateien angesehen zu haben - warum prüfst Du die letzte Zelle in Spalte E (...Cells(a, 5)...) wenn Du die Spalte H durchläufst? Das wäre die 8.

[Jan Von]

Hallöchen,

mal ohne Deine Dateien angesehen zu haben - warum prüfst Du die letzte Zelle in Spalte E (...Cells(a, 5)...) wenn Du die Spalte H durchläufst? Das wäre die 8.

H3 ist die Eingabe

(...Cells(a, 5)...) gesuchtes Zeichen aus H3

[Lutz Fricke]

Hallo Jon Von,

warum

Code:

If Not Application.Intersect(Target, Range("H3:H10")) Is Nothing Then

Du willst doch nur eine Prüfung, wenn der Wert in H3 geändert wurde...
Also:

Code:

If Not Application.Intersect(Target, Range("H3")) Is Nothing Then

Und was genau macht die an der Zeile

Code:

lngPos = InStr(1, LCase(wsDat.Cells(a, 5).Value), LCase(wsDat.Range("H3").Value))

zu schaffen?

Gruß´,
Lutz

[schauan]

Hallöchen,

von mir auch noch mal in "größerem" Zusammenhang. Mit der ...5 zielte ich auf Deine Schleife:

'** Spalte H ab Zeile 2 bis zur letzten gefüllten Zeile durchlaufen
For a = 2 To wsDat.Cells(Rows.Count, 5).End(xlUp).Row

Was Du da machst wäre

'** Spalte H ab Zeile 2 bis zur letzten gefüllten Zeile von Spalte E durchlaufen
For a = 2 To wsDat.Cells(Rows.Count, 5).End(xlUp).Row

Wenn E und H gleich voll sind, ist das zwar irrelevant, aber Du merkst, ohne weitere Erklärung bzw. Beschreibung erzeugt das Fragen. Und wenn E doch mal voller sein sollte kommen vielleicht Fehler, die nicht sein müssten und wo man sich vielleicht 'nen Wolf sucht ...

[Lutz Fricke]

Hallo schauan,

mit Blick in die Beispieldatei ist zu sehen, dass es ein Schreibfehler ist.
Das Makro durchläuft Spalte E von Zeile 2 bis zur letzten gefüllten Zelle.

Das passt schon...

Gruß,
Lutz

[Jan Von]

Hallo Jon Von,

warum

Code:

If Not Application.Intersect(Target, Range("H3:H10")) Is Nothing Then

Du willst doch nur eine Prüfung, wenn der Wert in H3 geändert wurde...
Also:

Code:

If Not Application.Intersect(Target, Range("H3")) Is Nothing Then

Und was genau macht die an der Zeile

Code:

lngPos = InStr(1, LCase(wsDat.Cells(a, 5).Value), LCase(wsDat.Range("H3").Value))

zu schaffen?

Sorry für die späte Antwort bin gerade eben erst von der Arbeit heim.

Mein Problem ist das ich ca 160 Dropdowns benötige. 20 Dropdowns via Formel ist kein Problem, dazu bräuchte ich kein Makro.
Die Liste welche abgefragt wird bleibt immer die selbe.

Ich habe ein Screen gemacht:
Eingabe Range "C2:Cxxx" in Makro wäre es "H3" soll jedoch "H3:Hxxx"


In Prinzip soll es so werden wie auf dem Screen.

[Lutz Fricke]

Hallo Jon Von,

es wird jetzt etwas wirr...

Bitte keine Bilder, sondern nur Dateien posten. Dann können alle damit arbeiten.
Ich habe leider erst jetzt festgestellt, wie deine einzelnen Posts zusammenhängen und wo genau Dein Problem liegt.

Ich habe aus deinem ursprünglichen Post die Datei Mappe_Test hergenommen. ACHTUNG, in Deinem zuletzt geposteten Bild sind die Spalten anders als in der ursprünglichen Datei...

Dein Problem ist, dass

Code:

lngPos = InStr(1, LCase(wsDat.Cells(a, 5).Value), LCase(wsDat.Range("H3").Value))

nur mit Bezug auf eine Zelle (also hier H3) funktioniert. Du kannst hier keinen Bereich eingeben. Also musst Du für jede einzelne Zeile im Eingabebereich deine Suchschleife durchlaufen.

Probier mal das:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'** Prüfen, ob der Wert in Zelle H2 geändert wurde
If Not Application.Intersect(Target, Range("C2:C9")) Is Nothing Then

  '** Screenupdating und Berechnung deaktivieren
'  With Application
'    .ScreenUpdating = False
'   .Calculation = xlCalculationManual
'  End With

  '** Dimensinionierung der Variablen
  Dim wsDat
  Dim lngZeile As Long
  Dim lngPos As Long

  '** Vorgaben definieren
  Set wsDat = ThisWorkbook.Sheets("Namenslist")

  '** Ausgabebereich löschen
  wsDat.Range("D2:L20").ClearContents

  For EinleseZeile = 2 To 9
   
      lngZeile = 2 '** Startzeile für Ausgabe in Spalte C
   
        '** Spalte H ab Zeile 2 bis zur letzten gefüllten Zeile durchlaufen
        For SuchZeile = 2 To wsDat.Cells(Rows.Count, 4).End(xlUp).Row
         
          '** Ermittlung der Position, ab der das gesuchte Zeichen aus Zelle C3 gefunden wurde
          lngPos = InStr(1, LCase(wsDat.Cells(SuchZeile, 4).Value), LCase(wsDat.Cells(EinleseZeile, 3).Value))
         
          '** Daten in Spalte C auflisten, wenn der Suchbegriff vorhanden ist
          If lngPos > 0 Then
            wsDat.Cells(lngZeile, EinleseZeile + 3).Value = wsDat.Cells(SuchZeile, 4).Value
           
            '** Zeilenzähler erhöhen
            lngZeile = lngZeile + 1
          End If
         
        Next SuchZeile
  Next EinleseZeile

  '**Berechnung und Bildschirmaktualisierung wieder einschalten
'  With Application
'    .ScreenUpdating = True
'    .Calculation = xlCalculationAutomatic
'  End With

End If

Ich habe die Bildschirmaktualisierung auskommentiert. Ist ein tolles Feature, macht beim Testen aber mehr Probleme als es hilft.

Nachdem es zwei Schleifen sind, habe ich a in Suchzeile umbenannt und EinlZeile für den Eingabebereich neu eingeführt.
Den Target-Bereich und den Ausgabebereich habe ich auf die verwendete Datei angepasst.
Die Ausgabezeile setze ich bei jeder neuen Zelle des Eingabebereichs auf die Zeile 2.

Du solltest (habe ich aber auch nicht gemacht) ALLE Variablen deklarieren. Zur Hilfe sollte vor jedes Makro ein "Option Explicit" gestellt werden. Damit wirst Du gezwungen jede Variable zu deklarieren und verhinderts evtl. Scghreibfehler.

Das Makro ist mangels wirklich aussagekräftiger Datei noch ungetestet.

Gruß,
Lutz