Excel: Wert aus Textfeld an Makro übergeben

Dieses Thema Excel: Wert aus Textfeld an Makro übergeben im Forum "Microsoft Office Suite" wurde erstellt von MichiMuc, 8. Juli 2006.

Thema: Excel: Wert aus Textfeld an Makro übergeben Hallo, ich habe ein UserForm mit einer Textbox. Diese darf nur mit Zahlen befüllt werden. Aus dieser Zahl soll dann...

  1. Hallo,

    ich habe ein UserForm mit einer Textbox. Diese darf nur mit Zahlen befüllt werden. Aus dieser Zahl soll dann ein Autofilter entstehen.

    Der Autofilter-Makro funktioniert, aber leider nur mit einer fest eingetragenen Zahl.

    Wie kann ich den Wert der Textbox in diesen Makro einsetzen?

    Vielen Dank,
    Michael.
     
  2. Was meinst Du denn mit
    Ist das ein eigenes Makro ? Oder meinst du die Autofilter-Funktion ?

    Wie soll den der Ablauf sein ?
    a) Makro aufrufen
    b) Makro ruft userform auf
    c) Eingabe in userform
    d) Überprüfung auf ganze Zahl, ggf wiederholter Aufruf Userform
    e) Zahl im Autfilter auf dem aktuellen Blatt setzen

    Fragen:
    in welcher Zeile liegt der Autofilter
    in welcher Spalte soll die Zahl als Suchbegriff gesetzt werden
    wie soll der suchbegriff gesetzt werden: gleich, größer, kleiner
    wie heißt die Userform
    wie heißt die Textbox auf der Userform

    Gruß Matjes :)
     
  3. Na hallo Matjes.
    Ich nerv Dich also schon wieder.
    Ähm, die Abfolge erfolgt so wie Du geschrieben hast und der Autofilter wird für die Zeit gesetzt, die Dein anderes Makro berechnet hat :)
    Das war also Spalte I.
    Nun soll im Userform eine Mindestzeit eingetragen werden, also z.B. 5 Minuten und der Autofilter dann alle Zeilen ausfiltern, in denen das Fahrzeug weniger als 5 Minuten stand.
    Grüße nochmal,
    Michael.
     
  4. Hallo Michi,

    ich hab mal die Userform durch eine inputBox ersetzt. Die Spalte mit der Zeitdifferenz war Spalte J.

    Ich hab zum anderen Makro noch 2 dazugeschrieben:
    - Excel_AutofilterLoeschen
    - Excel_AutofilterSetzenSpaltJ

    Der Autofilter wird jetzt in die Zeile 1 gesetzt. Wenn du ihn in einer anderen Zeile benötigst, passe bitte die Konstante cZEILEAUTOFILTER an.

    Benötigst du auch noch die Variante mit einer Userform ?

    Gruß Matjes :)
    Code:
    Option Explicit
    Private Const cTEST = True ->Schalter Test
                         ->true:  zu löschende Zeilen werden nur rot markiert
                         ->false: zu löschende Zeilen werden gelöscht
                         
    Private Const cZEILEAUTOFILTER = 1
    Private Const cABZEILE = 2 ->Zeile ab der Gruppen gesucht werden sollen
    Private Const cSPA = 1     ->Spalte Datum
    Private Const cSPB = 2     ->Spalte Uhrzeit
    Private Const cSPC = 3     ->Suchspalte C
    Private Const cSPJ = 10     'Spalte Zeitdifferenz in Minuten zwischen Anf-und Ende-Zeile
    Private Const cCIROT = 3   ->Farbindex rot
    Private Const cCIGRUEN = 50->Farbindex gruen (Meeresgrün)
    Private Const cCIGELB = 6   'Farbindex gelb
    '*********************************************************************************
    Sub Excel_AutofilterLoeschen()
      Dim ws As Worksheet
      Set ws = ActiveSheet
     ->Prüfen, ob Autofilter schon gesetzt ist
      If ws.AutoFilterMode Then ws.Cells(cZEILEAUTOFILTER, cSPJ).AutoFilter
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
    '*********************************************************************************
    Sub Excel_AutofilterSetzenSpaltJ()
      Dim ws As Worksheet
      Dim lZahl As Long, sZahl As String, sTmp As String, bNok As Boolean
      
     ->Untere Grenzzahl abfragen
      bNok = True
      Do While bNok
        sZahl = InputBox( _
                  Bitte geben Sie die untere Grenze für den Autofilter  & _
                 ->Zeitdifferenz' als Ganzzahl ein., _
                  Eingabe untere Grenze Zeitdifferenz, _
                  1)
        If sZahl =  Then Exit Sub
        On Error Resume Next: lZahl = sZahl: Err.Clear: On Error GoTo 0
        sTmp = lZahl
        If sTmp = sZahl Then bNok = False Else MsgBox Wert unzulässig:  & sZahl
      Loop
    
      Set ws = ActiveSheet
     ->Prüfen, ob Autofilter schon gesetzt ist, dann löschen
      If ws.AutoFilterMode Then ws.Cells(cZEILEAUTOFILTER, cSPJ).AutoFilter
     ->Autofilter setzen
      On Error Resume Next->falls Liste leer ist
      ws.Cells(cZEILEAUTOFILTER, cSPJ).AutoFilter _
                                          Field:=cSPJ, _
                                          Criteria1:=> & lZahl
      On Error GoTo 0
      
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
    
    '*********************************************************************************
    Sub Excel_SpalteCGruppenAnfEndeZeileStehenLassen()
    '*** Sucht Gruppen gleicher Begriffe in Spalte C
    '***
    '*** Von den Zeilen der Gruppe werden alle Zeilen
    '*** außer der 1. und letzten Zeile gelöscht
    '***
    '*** Hat die Gruppe nur eine Zeile bleibt die Zeile unverändert
    '*** Hat die Gruppe mehr als 1 Zeile, wird
    '***  - in der ersten  Zeile die Schrift grun
    '***  - in der letzten Zeile die Schrift rot
    '*** gesetzt. Dann wird auch die Zeitdifferenz in Spalte J gesetzt.
    '*** (Spalte A: Datum, Spalte B: Uhrzeit
    
      Dim ws As Worksheet
      Dim lLetzteZeile As Long, lLetzteSpalte As Long
      Dim ze As Long, za As Long, x As Long
      Dim lMinuten As Long
      
      Set ws = ActiveSheet
      With ws
      
        lLetzteSpalte = .UsedRange.Column + .UsedRange.Columns.Count - 1
        lLetzteZeile = .UsedRange.Row + .UsedRange.Rows.Count - 1
        
        ze = lLetzteZeile
        
        Do While ze > cABZEILE
          
         ->*** nächste Ende-Zeile einer Gruppe suchen
          Do While ze > cABZEILE
           ->Zelle nicht leer ?
            If .Cells(ze, cSPC).Value <>  Then Exit Do->Ende-Zeile gefunden
           ->nächste Zeile
            ze = ze - 1
          Loop
          
         ->*** keine Ende-Zeile mehr vorhanden ? ->
          If Not (ze > cABZEILE) Then Exit Do
          
         ->*** Anfangs-Zeile dieser Gruppe bestimmen
          za = ze
          Do While (za > cABZEILE)
            za = za - 1
           ->anderer Begriff ?
            If .Cells(za, cSPC).Value <> .Cells(ze, cSPC).Value Then
              za = za + 1
              Exit Do
            End If
          Loop
        
         ->ggf. Schrift-Farbe setzen, wenn Gruppe mehr als eine Zeile hat
         ->und Zeitdifferenz in Spalte J
          If za <> ze Then
            .Range(.Cells(za, 1), .Cells(za, lLetzteSpalte)).Font.ColorIndex = cCIGRUEN
            .Range(.Cells(ze, 1), .Cells(ze, lLetzteSpalte)).Font.ColorIndex = cCIROT
            lMinuten = ZeitdifferenzInMinuten(ws, za, ze, cSPA, cSPB)
            If lMinuten < 9999 Then
              .Cells(za, cSPJ).Value = lMinuten
              .Cells(ze, cSPJ).Value = lMinuten
            Else
              .Cells(za, cSPJ).Value = FEHLER
              .Cells(ze, cSPJ).Value = FEHLER
            End If
          End If
          
         ->*** ggf. Zwischen-Zeilen in dieser Gruppe löschen
          For x = (ze - 1) To (za + 1) Step -1
           ->Testbetrieb ?
            If cTEST Then
             ->Zellen der zu löschenden Zeile rot markieren
              .Range(.Cells(x, 1), .Cells(x, lLetzteSpalte)).Interior.ColorIndex = cCIGELB
            Else
             ->Zeile löschen
              .Rows(x).Delete
            End If
          Next
          
         ->*** nächsten Suchanfang setzen
          ze = za - 1
        Loop
    
      End With
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
    '**********************************************************************************
    Private Function ZeitdifferenzInMinuten(ws As Worksheet, _
                                            za As Long, ze As Long, _
                                            SPDatum As Long, SPUhrzeit As Long) As Long
     ->*** Berechnung der Zeitdifferenz in Minuten
     ->*** bei Fehler wird eine zeitdifferenz > 9999 zurückgeliefert
      
      Dim dDateDatum_za As Date, dDateUhrzeit_za As Date
      Dim dDateDatum_ze As Date, dDateUhrzeit_ze As Date
      Dim lStunde As Long, lMinute As Long
      Dim dZeitdifferenz As Date
      
      On Error Resume Next
      ZeitdifferenzInMinuten = 100000
      
     ->*** Anfangszeit
      If ws.Cells(za, SPDatum).Value =  Then Exit Function
      dDateDatum_za = ws.Cells(za, SPDatum).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      If ws.Cells(za, SPUhrzeit).Value =  Then Exit Function
      dDateUhrzeit_za = ws.Cells(za, SPUhrzeit).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      lStunde = Hour(dDateUhrzeit_za)
      lMinute = Minute(dDateUhrzeit_za)
      dDateDatum_za = DateAdd(h, lStunde, dDateDatum_za)
      dDateDatum_za = DateAdd(n, lMinute, dDateDatum_za)
    
      
     ->*** Endezeit
      If ws.Cells(ze, SPDatum).Value =  Then Exit Function
      dDateDatum_ze = ws.Cells(ze, SPDatum).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      If ws.Cells(ze, SPUhrzeit).Value =  Then Exit Function
      dDateUhrzeit_ze = ws.Cells(ze, SPUhrzeit).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      lStunde = Hour(dDateUhrzeit_ze)
      lMinute = Minute(dDateUhrzeit_ze)
      dDateDatum_ze = DateAdd(h, lStunde, dDateDatum_ze)
      dDateDatum_ze = DateAdd(n, lMinute, dDateDatum_ze)
      
    
     ->*** Zeitdifferenz
      If dDateDatum_ze < dDateDatum_za Then Exit Function
      ZeitdifferenzInMinuten = DateDiff(n, dDateDatum_za, dDateDatum_ze)
    
    End Function
     
  5. Hallo Matjes.
    Vielen Dank, funktioniert super.
    Mal sehen, ob ich ein Userform brauche. Aber da werd ich mich mal selbst dran versuchen :)
    Wenn Du mir sagen könntest, wie ich einen Wert aus einer Textbox für den Autofilter übernehme. Wäre super.
    Danke,
    Michael.
     
Die Seite wird geladen...

Excel: Wert aus Textfeld an Makro übergeben - Ähnliche Themen

Forum Datum
Excel Tabelle Werte zu ordnen Microsoft Office Suite 23. Sep. 2016
Excel '10 - Frage zu Option "AutoVervollständigen für Zellwerte!" Microsoft Office Suite 16. Juli 2012
Excel 2010 - Pivot Tabelle - Brauche Hilfe bei Mittelwertbildung Microsoft Office Suite 13. Feb. 2012
Excel: Summe beliebiger Anzahl Zellen (also nicht die Werte) ? Microsoft Office Suite 2. Dez. 2010
Excel - Werte unterschiedlicher Tabellenblätter für Übersicht automatisch ziehen Microsoft Office Suite 22. Aug. 2010