Werte aus A, nicht mehr I

Private Sub Workbook_Open() Application.ScreenUpdating = False Sheets("Maßnahmen").Activate 'Range("A1").Select Sheets("Einstellungen").Activate Range("A1").Select 'Sheets("Einstellungen").Activate Worksheets("Einstellungen").ComboBox2 = "" Worksheets("Einstellungen").ComboBox1 = "" Worksheets("Einstellungen").ComboBox3 = "" Worksheets("Einstellungen").ComboBox4 = "" For s = 2 To Worksheets("Maßnahmen").Range("I65536").End(xlUp).Row If Worksheets("Maßnahmen").Cells(s, 1).Value "" Then If Application.WorksheetFunction.CountIf(Worksheets("Maßnahmen").Range(Worksheets("Maßnahmen"). _ _ Cells(s, 1), _ Worksheets("Maßnahmen").Cells(1, 1)), Worksheets("Maßnahmen").Cells(s, 1).Value) = 1 _ Then Worksheets("Einstellungen").ComboBox1.AddItem (Worksheets("Maßnahmen").Cells(s, 1).Value) End If Next Application.ScreenUpdating = True End Sub

For s = 2 To Worksheets("Maßnahmen").Range("I65536").End(xlUp).Row If Worksheets("Maßnahmen").Cells(s, 9).Value "" Then If Application.WorksheetFunction.CountIf(Worksheets("Maßnahmen").Range(Worksheets("Maßnahmen"). _ _ Cells(s, 9), _ Worksheets("Maßnahmen").Cells(1, 9)), Worksheets("Maßnahmen").Cells(s, 9).Value) = 1 _ Then Worksheets("Einstellungen").ComboBox1.AddItem (Worksheets("Maßnahmen").Cells(s, 9).Value) End If Next

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Wolfgang,
ungetestet!


' **********************************************************************
' Modul: DieseArbeitsmappe  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_Open()
  Dim vntList As Variant
  
  On Error GoTo ErrExit
  Application.ScreenUpdating = False
  
  With Worksheets("Maßnahmen")
    vntList = UniqueList(.Range("A2:A" & Application.Max(2, .Cells(.Rows.Count, 1).End(xlUp).Row)))
  End With
  
  With Worksheets("Einstellungen")
    .Activate
    .Range("A1").Select
    .ComboBox2 = ""
    .ComboBox1 = ""
    .ComboBox3 = ""
    .ComboBox4 = ""
    .ComboBox1.List = vntList
  End With
  
  ErrExit:
  Application.ScreenUpdating = True
End Sub


' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Function UniqueList(Matrix As Range, Optional VisibleCellsOnly As Boolean = True, Optional IncludeNull As Boolean = True, Optional Sorted As Boolean = True) As Variant
  Dim objDic As Object, rng As Range, varTmp() As Variant, vntExclude As Variant
  
  Set objDic = CreateObject("Scripting.Dictionary")
  
  vntExclude = IIf(IncludeNull, "", 0)
  
  If VisibleCellsOnly Then Set Matrix = Matrix.SpecialCells(xlCellTypeVisible)
  
  For Each rng In Matrix.Cells
    If rng.Value <> vntExclude Then objDic(rng.Value) = 0
  Next
  
  varTmp = objDic.keys
  
  If Sorted Then QuickSort varTmp
  
  UniqueList = varTmp
  
  Set objDic = Nothing
End Function


Private Sub QuickSort(data() As Variant, Optional UG, Optional OG)
  Dim P1&, P2&, T1 As Variant, T2 As Variant
  
  UG = IIf(IsMissing(UG), LBound(data), UG)
  OG = IIf(IsMissing(OG), UBound(data), OG)
  
  P1 = UG
  P2 = OG
  T1 = data((P1 + P2) / 2)
  
  Do
    
    Do While (data(P1) < T1)
      P1 = P1 + 1
    Loop
    
    Do While (data(P2) > T1)
      P2 = P2 - 1
    Loop
    
    If P1 <= P2 Then
      T2 = data(P1)
      data(P1) = data(P2)
      data(P2) = T2
      P1 = P1 + 1
      P2 = P2 - 1
    End If
    
  Loop Until (P1 > P2)
  
  If UG < P2 Then QuickSort data, UG, P2
  If P1 < OG Then QuickSort data, P1, OG
  
End Sub

« Gruß Sepp »

Hallo Hary,
Danke zunächst für Deine schnelle Rückantwort. Erreichen möchte ich, dass die Combobox1 zunächst mit den Daten aus Spalte A gefüllt wird und in Combobox2 wiederum die gefilterten Daten aus Spalte B anzeigt und in ComboBox3 dann wiederum die gefilterten Daten aus Spalte C - aus Spalte D dann zum Schluss die verbleibenden Daten in ComboBox4. Erreichen würde ich dann gerne, dass die dann gefilterten Datensätze endültig in der Tabelle "Einstellungen" ab A 14 angezeigt werden. Ich habe mir erlaubt, eine Mustermappe anzuhängen, die ich in ähnlichem Format im Forum entdecken konnte. Danke nochmals!
Gruß - Wolfgang

Die Datei https://www.herber.de/bbs/user/76751.xlsm wurde aus Datenschutzgründen gelöscht

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte aus A, nicht mehr I

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread