Kombinationsfelder

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
Das geht auch ohne VBA-Code über sog. dynamische Namen, dh das sind Namen, bei den den der Zellbereichen per Formel berechnet wird
Für das erste DropDown musst du noch normal einen statischen Zellbereich verwenden, dh die Herstellerspalte kopieren und dann die Duplikate entfernen.
Für die Geräteauswahl gehst du dann so vor:
1. die Liste muss nach Hersteller aufsteigend sortiert sein.
2. erstellen einen Namen mit dieser Formel bei "bezieht sich auf", beim schreiben dieser Formel im Namensmanager ist es sinnvoll, wenn du schon einen Hersteller ausgewählt hast:

=Index(Tabelle2!B:B;Vergleich(Tabelle1!g3;Tabelle2!A:A;0)):Index(Tabelle2!B:B;Vergleich(Tabelle1!g3; Tabelle2!A:A;1))

Diesen Namen verwendet du als Quelle für dein DropDown.
Man nutzt hier aus, dass der Vergleich mit 0 als 3. Parameter immer die Zeilennummer der ersten Fundstelle ausgibt, mit 1 als 3. Parameter die Zeilennummer der letzten Fundstelle.
Die Liste muss aber nach den Suchwerten aufsteigend sortiert sein.
Gruß Daniel

Hallo Edi,
wenn Du es doch lieber mit Makro machen möchtest, hier mal eine Anregung, wie man es machen könnte.
Kompletten Code habe ich mal in die anliegende Datei eingefügt und hier noch einen Ausschnitt zur Voransicht:
https://www.herber.de/bbs/user/136644.xlsb

Option Explicit

Sub FuelleDDHersteller()

 Dim Obj As Range, sSchonDrin As String, sArr() As String, oRette As Range

 Sheets("Tabelle1").Select

 Set oRette = ActiveCell

 For Each Obj In Sheets("Tabelle2").Range("$A2:$A" _

  & Sheets("Tabelle2").UsedRange.Rows.Count)

  If Obj.Value &LT;&GT; "" Then

   If InStr(sSchonDrin, Obj.Value & ",") = 0 Then

      sSchonDrin = sSchonDrin & Obj.Value & ","

   End If

  End If

 Next Obj

 sArr = Split(sSchonDrin, ",")

 Sheets("Tabelle3").Cells(2, 1).Resize(UBound(sArr), 1).Value = Application.Transpose(sArr)

 Sheets("Tabelle3").Range("$A$1").Value = 1

 Sheets("Tabelle1").Shapes.Range(Array("Dropdown 1")).Select

 With Selection

      .ListFillRange = "Tabelle3!$A$2:$A$" & UBound(sArr) + 1

      .LinkedCell = "Tabelle3!$A$1"

      .DropDownLines = 8

      .Display3DShading = False

 End With

 oRette.Select

End Sub

Sub FuelleDDGeraete()

 Dim Obj As Range, sSchonDrin As String, sArr() As String, oRette As Range

 Dim sHersteller As String

 With Sheets("Tabelle3")

   sHersteller = .Cells(.Cells(1, 1).Value + 1, "A").Value

 End With

 Sheets("Tabelle1").Select

 Sheets("Tabelle1").Range("$G$3").Value = sHersteller

 Set oRette = ActiveCell

 For Each Obj In Sheets("Tabelle2").Range("$B2:$B" _

  & Sheets("Tabelle2").UsedRange.Rows.Count)

  If Obj.Value &LT;&GT; "" And Obj.Offset(0, -1).Value Like sHersteller Then

   If InStr(sSchonDrin, Obj.Value & ",") = 0 Then

      sSchonDrin = sSchonDrin & Obj.Value & ","

   End If

  End If

 Next Obj

 sArr = Split(sSchonDrin, ",")

 Sheets("Tabelle3").Cells(2, 2).Resize(UBound(sArr), 1).Value = Application.Transpose(sArr)

 Sheets("Tabelle3").Range("$B$1").Value = 1

 Sheets("Tabelle1").Shapes.Range(Array("Dropdown 2")).Select

 With Selection

      .ListFillRange = "Tabelle3!$B$2:$B$" & UBound(sArr) + 1

      .LinkedCell = "Tabelle3!$B$1"

      .DropDownLines = 8

      .Display3DShading = False

 End With

 oRette.Select

End Sub

Sub Dropdown1_Beiänderung()

 Call FuelleDDGeraete

End Sub

Sub Dropdown2_Beiänderung()

 Dim sGeraet As String

 With Sheets("Tabelle3")

   sGeraet = .Cells(.Cells(1, 2).Value + 1, "B").Value

 End With

 Sheets("Tabelle1").Select

 Sheets("Tabelle1").Range("$G$5").Value = sGeraet

End Sub

viele Grüße
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread