title image


Smiley ich würde es so machen ( sehr schnell )


Option Explicit



' Code auf der Userform

' 1 Listbox / 1 Combobox



Private Const TBL = "Tabelle2"

Private blk As Boolean

Private Const STARTRANGE = "D2"



Private Sub Userform_Initialize()

  blk = True

    With ComboBox2

        .AddItem "Januar"

        .AddItem "Februar"

        .AddItem "Maerz"

        .AddItem "April"

        .AddItem "Mai"

        .AddItem "Juni"

        .AddItem "Juli"

        .AddItem "August"

        .AddItem "September"

        .AddItem "Oktober"

        .AddItem "Novmber"

        .AddItem "Dezember"

        .Text = .List(0)

        MonatSuchen .List(0)

    End With

  blk = False

End Sub



Private Sub Combobox2_Click()

  If blk Then Exit Sub

  MonatSuchen ComboBox2.Text

End Sub





Private Sub MonatSuchen(Suchbegriff As String)

Dim SRang As Range, Cl As Range, fsta$



    ' Das ist das gleiche ( Range("A2").Column ) gibt auf jedem Blatt den gleichen Wert

    

        ListBox2.Clear: ListBox2.ColumnCount = 4

        'Suchbegriff = ComboBox2

        With Worksheets(TBL)

         Set SRang = .Range(.Cells(Range(STARTRANGE).Row, Range(STARTRANGE).Column), _

                            .Cells(.Cells(Rows.Count, Range(STARTRANGE).Column).End(xlUp).Row, _

                                   Range(STARTRANGE).Column))

       

        

        End With

        If SRang Is Nothing Then Exit Sub

        With SRang

           Set Cl = .Find(Suchbegriff, lookat:=xlPart)

           If Not Cl Is Nothing Then

                fsta = Cl.Address

                Do

                   With ListBox2

                      .AddItem Cl.AddressLocal(False, False)

                      .List(.ListCount - 1, 1) = Cl.Value

                      .List(.ListCount - 1, 2) = Cl.Offset(0, -1).Value

                      .List(.ListCount - 1, 3) = Cl.Offset(0, 10).Value

                   End With

                   Set Cl = .FindNext(Cl)

                Loop While Cl.Address <> fsta

          End If

        End With

        Set SRang = Nothing: Set Cl = Nothing

End Sub





 Code eingefügt mit Syntaxhighlighter 1.16

Knofi So wie wir heute arbeiten, werden morgen die Beamten leben ...

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: