Eingabemaske

[Kuwer]

Hallo,

das wäre jetzt mein Vorschlag:

Code:

Option Explicit

Private Sub ComboBox1_Click()
 Dim i As Long
 If ComboBox1.ListIndex <> 0 Then
   For i = 1 To 24
     Me.Controls("TextBox" & i) = Cells(ComboBox1.ListIndex + 3, i).Value
   Next i
 Else
   For i = 1 To 24
     Me.Controls("TextBox" & i) = ""
   Next i
 End If
End Sub

Private Sub CommandButton1_Click()
 Dim i As Long
 If ComboBox1.ListIndex > 0 Then
   Rows(ComboBox1.ListIndex + 3).Delete
   For i = 1 To 24
     Me.Controls("TextBox" & i) = ""
   Next i
   UserForm_Initialize
 End If
End Sub

Private Sub CommandButton2_Click()
 Dim i As Long
 Dim xZeile As Long
 If TextBox1 = "" Then Exit Sub
 If ComboBox1.ListIndex = 0 Then
   xZeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
 Else
   xZeile = ComboBox1.ListIndex + 3
 End If
 For i = 1 To 24
   Select Case i
     Case Is = 2, 18, 20, 22, 23 'Datumfelder
       If IsDate(Me.Controls("TextBox" & i)) Then
         Cells(xZeile, i).Value = CDate(Me.Controls("TextBox" & i))
       Else
         Cells(xZeile, i) = ""
       End If
     Case Else
       Cells(xZeile, i).Value = Me.Controls("TextBox" & i)
   End Select
   Me.Controls("TextBox" & i) = ""
 Next i
 Range("A3:AT" & xZeile).Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlYes, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 UserForm_Initialize
End Sub

Private Sub UserForm_Initialize()
 Dim i As Long
 ComboBox1.Clear
 ComboBox1.AddItem "Neuen Patienten hinzufügen"
 For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
   ComboBox1.AddItem Cells(i, 1).Value & ", " & Cells(i, 2).Value
 Next i
 ComboBox1.ListIndex = 0
End Sub

Private Sub CommandButton3_Click()
 Unload Me
End Sub

Gruß Uwe

[Geri]

Hallo 

fantastisch was man machen kann!!!!!
Danke, Danke an euch alle :18: :18: :18:
 
Möchte nun nicht unverschämt werden aber wenn es möglich ist
bitte helft mir noch bei den Filtern 
Ich möchte einen beliebigen Tag und einen Zeitraum im OP Termin abfragen

Sub Datum_Gleich()
Dim Datum As Date

Datum = "22.06.2016" (sollte von der jeweiligen Zelle übernommen werden)

Rows("1:1").AutoFilter Field:=22, Criteria1:="<=" & CDbl(Datum), Operator:=xlAnd, Criteria2:=">=" & CDbl(Datum)

End Sub

Sub Datum_Zwischen()

Dim Datum1 As Date, Datum2 As Date

Datum1 = "01.05.2006" (sollte von den jeweiligen Zellen übernommen werden)
Datum2 = "31.12.2009"
                            
Rows("1:1").AutoFilter Field:=22, Criteria1:=">=" & CDbl(Datum1), Operator:=xlAnd, Criteria2:="<=" & CDbl(Datum2)

End Sub

Nochmals vielen Dank an euch allen bin in den letzten Wochen verzweifelt

[Rabe]

Hi,

das wäre jetzt mein Vorschlag:

da Zahlen in den Spalten auch als Zahlen dastehen sollen und die Telefonnummer als Text, habe ich hier noch eine Ergänzung:

Code:

Private Sub CommandButton2_Click()              'neuen Patienten übernehmen
  Dim i As Long
  Dim xZeile As Long
  If TextBox1 = "" Then Exit Sub
  If ComboBox1.ListIndex = 0 Then
     xZeile = Cells(Rows.Count, 1).End(xlUp).Row + 1     'Letzte Zeile der Spalte A (1)
  Else
     xZeile = ComboBox1.ListIndex + 3
  End If
  For i = 1 To 24
     Select Case i
     Case Is = 2, 18, 20, 22, 23               'Datumfelder
        If IsDate(Me.Controls("TextBox" & i)) Then
           Cells(xZeile, i).Value = CDate(Me.Controls("TextBox" & i))
        Else
           Cells(xZeile, i) = ""
        End If
     Case Is = 11, 14, 15                   'Zahlenfelder
        If IsNumeric(Me.Controls("TextBox" & i)) Then
           Cells(xZeile, i).Value = CLng(Me.Controls("TextBox" & i))
        Else
           Cells(xZeile, i) = ""
        End If
     Case Is = 19                           'Telefonnummer
           Cells(xZeile, i).Value = CStr(Me.Controls("TextBox" & i))
        End If
     Case Else
        Cells(xZeile, i).Value = Me.Controls("TextBox" & i)
     End Select
     Me.Controls("TextBox" & i) = ""
  Next i
  Range("A3:AT" & xZeile).Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  UserForm_Initialize
End Sub

Und da TE Excel 2010 verwendet, habe ich es als xlsb abgespeichert, dann ist es nur noch 1/3 so groß.

  Eingabemaske3 - V03.xlsb (Größe: 39,68 KB / Downloads: 8)

[edit] das Filtern ist auch eingebaut.

[Rabe]

Hi,

bitte helft mir noch bei den Filtern 
Ich möchte einen beliebigen Tag und einen Zeitraum im OP Termin abfragen

hier die Filter-Codes:

Code:

Sub Datum_Gleich()
   Dim Datum As Date
   Dim loLetzte As Long
  
   loLetzte = Cells(Rows.Count, 1).End(xlUp).Row + 1     'Letzte Zeile der Spalte A (1)
  
   Datum = Range("A2")
   Rows("4:" & loLetzte).AutoFilter Field:=22, Criteria1:="<=" & CDbl(Datum), Operator:=xlAnd, Criteria2:=">=" & CDbl(Datum)
  
End Sub

Sub Datum_Zwischen()
   Dim Datum1 As Date, Datum2 As Date
   Dim loLetzte As Long
  
   loLetzte = Cells(Rows.Count, 1).End(xlUp).Row + 1     'Letzte Zeile der Spalte A (1)
  
   Datum1 = Range("B2")
   Datum2 = Range("C2")
  
   Rows("4:" & loLetzte).AutoFilter Field:=22, Criteria1:=">=" & CDbl(Datum1), Operator:=xlAnd, Criteria2:="<=" & CDbl(Datum2)
  
End Sub

Sub FilterRücksetzen()
   '
   ' Rabe of Clever-Excel-Forum.de
   ' 24.06.2016
   '
  
   '
   ActiveSheet.ShowAllData
End Sub

[Geri]

Super  :19: Alle Filter funktionieren
Leider kann ich die Eingabemaske nicht mehr öffnen
Es schaut so aus als wäre sie im Entwurfsmodus
Ich habe den abgeänderten Code bezüglich Datum in die Tabelle kopiert dort kommt bei der Telefonnummer
ein end if Fehler

Hänge die Datei, welche inzwischen eure ist noch einmal an

Danke für eure große Hilfe.

Geri


  Eingabemaske2 probe - V02.xls (Größe: 91 KB / Downloads: 1)

[Rabe]

Hi,

Ich habe den abgeänderten Code bezüglich Datum in die Tabelle kopiert dort kommt bei der Telefonnummer
ein end if Fehler

Hänge die Datei, welche inzwischen eure ist noch einmal an

Das "End If" ist an der Stelle überflüssig!

Und was ist der Unterschied zwischen Deiner und meiner?
Warum hast Du nicht die xlsb genommen?

Filter, Telefonnummer und Eingabemaske funktionieren jetzt wieder:

  Eingabemaske3 - V03.xls (Größe: 102 KB / Downloads: 5)

  Eingabemaske3 - V03.xlsb (Größe: 40,34 KB / Downloads: 10)

[Geri]

Habe jetzt diese Datei heruntergeladen
und alles funktioniert. Ich weiß nicht wie ich euch allen danken kann.
Dass ich das so von euch bekommen habe ist wie Weihnachten und Ostern zusammen
Vielen vielen Dank und alles Gute für euch alle
:18: :18: :18:

[Rabe]

Hi,

Sonst ist sie top. Bin zur Zeit auf einem PC mit office 2003 vielleicht geht es deswegen nicht

ok, dann ist das klar, das wäre interessant gewesen, das zu wissen.
Es gibt von Microsoft so ein kostenloses Konvertiertool, das macht das hin- und herwandeln zwischen 2003 und 2010 automatisch beim Öffnen.