Clever-Excel-Forum

Seiten: 1 2

Weil ich die Daten, auf welche sich das Dropdown bezieht, nicht im Sheet, sondern direkt im Makro erfassen möchte. Ich möchte im Sheet keine Daten haben, auch nicht ausgeblendet.

Dies sollte möglich sein, oder? Ich kriegs jedenfalls nicht hin.

Vielen Dank euch allen!!!

Habs nun trotzdem über den Namensmanager gemacht. Im Makro wärs "schöner" gewesen, geht allerdings auch so.

@mauritius5, Undecided

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim lngS As Long

  Dim strS As String

  Dim strV(1 To 4, 1 To 3) As String

  If Target.Cells(1).Address = "$B$3" Then

    strS = LCase(Left(Target.Cells(1).Value, 4))

    lngS = ((strS = "deut") * -1) + ((strS = "fran") * -2) + ((strS = "ital") * -3)

    strV(1, 1) = "Präsenzkurs"

    strV(2, 1) = "Onlinekurs"

    strV(3, 1) = "Kurs ohne Theorieanteil"

    strV(4, 1) = "Kurs mit Theorieanteil"

    strV(1, 2) = "Cours de présence"

    strV(2, 2) = "Cours en ligne"

    strV(3, 2) = "Cours sans partie théorique"

    strV(4, 2) = "Cours avec partie théorique"

    strV(1, 3) = "Corso in aula"

    strV(2, 3) = "Corso online"

    strV(3, 3) = "Corso senza teoria"

    strV(4, 3) = "Corso con componente teorica"

    Select Case Range("B4").Value

      Case strV(1, 1), strV(1, 2), strV(1, 3)

        Range("B4").Value = strV(1, lngS)

      Case strV(2, 1), strV(2, 2), strV(2, 3)

        Range("B4").Value = strV(2, lngS)

    End Select

    If Not Intersect(Range("B4"), Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then

      Range("B4").Validation.Modify xlValidateList, , , "" & strV(1, lngS) & ", " & strV(2, lngS) & ""

    Else

      Range("B4").Validation.Add xlValidateList, , , "" & strV(1, lngS) & ", " & strV(2, lngS) & ""

    End If

    Select Case Range("B5").Value

      Case strV(3, 1), strV(3, 2), strV(3, 3)

        Range("B5").Value = strV(3, lngS)

      Case strV(4, 1), strV(4, 2), strV(4, 3)

        Range("B5").Value = strV(4, lngS)

    End Select

    If Not Intersect(Range("B5"), Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then

      Range("B5").Validation.Modify xlValidateList, , , "" & strV(3, lngS) & ", " & strV(4, lngS) & ""

    Else

      Range("B5").Validation.Add xlValidateList, , , "" & strV(3, lngS) & ", " & strV(4, lngS) & ""

    End If

  End If

End Sub

Gruß Uwe

Oder nur:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Address = "$B$1" Then

      st = Split(Split("Präsenzkurs_Onlinekurs_Kurs ohne Theorieanteil_Kurs mit Theorieanteil|Cours de présence_Cours en ligne_Cours sans partie théorique_Cours avec partie théorique|Corso in aula_Corso online_Corso senza teoria_Corso con componente teorica", "|")(InStr("DFI", Left(Target, 1)) - 1), "_")

      Target.Offset(1).Validation.Modify 3, , , st(0) & ", " & st(1)

      Target.Offset(2).Validation.Modify 3, , , st(2) & ", " & st(3)

  End If

End Sub

@Kuw

Target.cells(1).address = target.address

Warum "" in Validation.modify ?

(05.12.2022, 13:49)snb schrieb: [ -> ]Target.cells(1).address = target.address

Das stimmt aber nicht immer!
Markiere A1:B1 und drücke die Entf-Taste (engl.: Del-Key)
?Target.Cells(1).Address --> $A$1
?Target.Address --> $A$1:$B$1

Korrekt wäre in diesem Fall eigentlich:

Code:
If Not Intersect(Target, Range("B1") Is Nothing Then

Und nachfolgend dann statt Target immer Range("B1") verwenden.

@HK

Das ist nur theoretisch.
In diesem Fall, mit Validation in B1 ist Target=Range("A1:B1") unsinn.
Der Code sollte nur laufen wenn B1 beabsichtlich geändert is.

Hallo,

ich hatte noch den Teil vergessen, wenn B3 geleert wird und die "" & "" entfernt: Blush

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

  Dim lngS As Long

  Dim strS As String

  Dim strV(1 To 4, 1 To 3) As String

  If Target.Cells(1).Address = "$B$3" Then

    strS = LCase(Left(Target.Cells(1).Value, 4))

    lngS = ((strS = "deut") * -1) + ((strS = "fran") * -2) + ((strS = "ital") * -3)

    If lngS Then

      strV(1, 1) = "Präsenzkurs"

      strV(2, 1) = "Onlinekurs"

      strV(3, 1) = "Kurs ohne Theorieanteil"

      strV(4, 1) = "Kurs mit Theorieanteil"

      strV(1, 2) = "Cours de présence"

      strV(2, 2) = "Cours en ligne"

      strV(3, 2) = "Cours sans partie théorique"

      strV(4, 2) = "Cours avec partie théorique"

      strV(1, 3) = "Corso in aula"

      strV(2, 3) = "Corso online"

      strV(3, 3) = "Corso senza teoria"

      strV(4, 3) = "Corso con componente teorica"

      Select Case Range("B4").Value

        Case strV(1, 1), strV(1, 2), strV(1, 3)

          Range("B4").Value = strV(1, lngS)

        Case strV(2, 1), strV(2, 2), strV(2, 3)

          Range("B4").Value = strV(2, lngS)

      End Select

      If Not Intersect(Range("B4"), Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then

        Range("B4").Validation.Modify xlValidateList, , , strV(1, lngS) & ", " & strV(2, lngS)

      Else

        Range("B4").Validation.Add xlValidateList, , , strV(1, lngS) & ", " & strV(2, lngS)

      End If

      Select Case Range("B5").Value

        Case strV(3, 1), strV(3, 2), strV(3, 3)

          Range("B5").Value = strV(3, lngS)

        Case strV(4, 1), strV(4, 2), strV(4, 3)

          Range("B5").Value = strV(4, lngS)

      End Select

      If Not Intersect(Range("B5"), Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then

        Range("B5").Validation.Modify xlValidateList, , , strV(3, lngS) & ", " & strV(4, lngS)

      Else

        Range("B5").Validation.Add xlValidateList, , , strV(3, lngS) & ", " & strV(4, lngS)

      End If

    Else

      Range("B4:B5") = ""

      If Not Intersect(Range("B4"), Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then

        Range("B4").Validation.Delete

      End If

      If Not Intersect(Range("B5"), Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then

        Range("B5").Validation.Delete

      End If

    End If

  End If

End Sub

Vielen, vielen Dank euch allen. Hat geklappt Smile

Seiten: 1 2

mauritius5

Kuwer

snb

HKindler

snb

Kuwer

mauritius5