Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA-Projekt_Hilfe alles
#1
Hallo zusammen!

In der Anlage habe ich mal mein Projekt angefügt. Eine erste Frage wurde mir schon beantwortet und konnte ich schon umsetzen. Das Projekt möchte ich gerne weiterentwickeln und würde gerne auch auf Eure Hilfe zurückgreifen.

Was bereits funktioniert ist, dass ich über eine ComboBox Aktenzeichen suchen kann und dann der komplette Datensatz angezeigt wird. Die Suche ist allerdings doch sehr beschränkt. Man könnte ja auch auf die Idee kommen mal nach Namen zu suchen oder nach der ID-Nr.. Mit der ComboBox bin ich aber auch eigentlich nicht ganz zufrieden. Lieber wäre mir, ich könnte in einem oder mehreren Textfeldern was eingeben und dann per Button suchen. Vielleicht kann mir mal einer für das Feld Name ein Beispiel erstellen und nach Möglichkeit die Sache auskommentieren, damit ich verstehe welcher Code was macht.

Danke und noch einen schönen Sonntagabend

Grüße
Sandor



.xlsm   test.xlsm (Größe: 33,5 KB / Downloads: 7)
Antwortento top
#2
Jut... Selbst ist der Mann  32  

Habe im Userform6 die Combox entfernt und kann nun schon über CommandButton die Suche auslösen und mit weiterem Button das Formular löschen. Theoretisch und Praktisch lässt sich damit für meinen Anwendungsfall die Suche abwickeln, muss aber noch optimiert werden. Kommt noch.

Folgenden Code habe ich "gebastelt":
Code:
Private Sub CommandButton1_Click()
    
    
    On Error GoTo EERR
    Dim AAAZ As Long
    Dim AAAC As Long
    
    If TextBox1 <> "" Then
        Dim SUCHENWAS As Variant
        SUCHENWAS = TextBox1.Value
        ActiveSheet.Range("a12:a1048576").Cells.Find(What:=SUCHENWAS, lookat:=xlWhole).Activate
        
        AAAZ = CDbl(ActiveCell.Row)
        AAAC = CDbl(ActiveCell.Column)
        TextBox2.Value = ActiveSheet.Cells(AAAZ, AAAC + 2).Value
        TextBox3.Value = ActiveSheet.Cells(AAAZ, AAAC + 3).Value
        
    ElseIf TextBox2 <> "" Then
        SUCHENWAS = TextBox2.Value
        ActiveSheet.Range("c12:c1048576").Cells.Find(What:=SUCHENWAS, lookat:=xlWhole).Activate
        
        AAAZ = CDbl(ActiveCell.Row)
        AAAC = CDbl(ActiveCell.Column)
        TextBox1.Value = ActiveSheet.Cells(AAAZ, AAAC - 2).Value
        TextBox3.Value = ActiveSheet.Cells(AAAZ, AAAC + 1).Value
        
    End If
    Exit Sub
    
    
EERR:
    
End Sub

Nun ist es aber so, dass ich wenn ich z.B. das Aktenzeichen 123456 eingebe, nur einen Datensatz angezeigt bekomme. Möchte ich alle Sätze mit 123456 angezeigt bekommen, dann müsste ich wohl mit ListBox arbeiten?


Angehängte Dateien
.xlsm   test.xlsm (Größe: 30,69 KB / Downloads: 4)
Antwortento top
#3
Ich hab mir jetzt für den Anfang Excel-VBA für Dummies gekauft und melde mich dann wieder, wenn ich das durchgearbeitet habe. Dann verstehe ich auch was ich frage Blush
Antwortento top
#4
Hallöchen,

mal erste Hinweise auf Deinen code.

Dim AAAZ As Long
Dim AAAC As Long
...
AAAZ = CDbl(ActiveCell.Row)
AAAC = CDbl(ActiveCell.Column)

Du definierst hier Variablen, von denen Du später eventuell nicht mehr weist, wozu die gut sind - geht jedenfalls aus dem Namen nicht hervor - als Long und versuchst dann, die Werte über eine Umwandlungsfunktion als Double zuzuweisen. Du brauchst hier nichts umzuwandeln.

Wenn nicht gefunden wird, dann läuft Dein code auf einen Fehler. Da gibt es verschiedene Wege, gegenzusteuern.

Die Listbox wäre ok, das hast Du richtig erkannt. Die füllst Du dann mit einer Schleife, musst natürlich ach nach dem nächsten Treffer suchen, schaue dazu mal nach FindNext. Alternativ, wenn die Daten sortiert sind, könnte man nach dem ersten Treffer auch mit einer Schleiffe den Zellinhalt mit dem Suchbegriff vergleichen und solange durchschleifen, wie der Suchtext enthalten ist.
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
Antwortento top
#5
Danke für den Tipp. Hab meinen Code mal korrigiert und das was ich wollte funktioniert auch erstmal. Schön ist der Code noch nicht. Aber das soll erstmal egal sein. Feintuning kommt noch Blush
Antwortento top
#6
Korrektur... Funktioniert fast. Den Code schieb ich noch nach, wenn gebraucht, aber mal ne Frage zu Userform, Tabellenblatt und Berechnung. Per Userform befülle ich ein Tabellenblatt. Das funktioniert. Auf einem weiteren Blatt habe ich Formeln hinterlegt, die sich aus dem mit Userform befülltem Blatt Daten holen sollen und dann berechnen. Und hier ist der Haken. Gebe ich händisch, also ohne Userform direkt die Daten ins Tabellenblatt ein, dann berechnet er mir die Formeln, mache ich das über Userform, dann macht er mir die Berechnung nicht. Eine Idee ohne den Code zu sehen? Eine Einstellungsfrage? Unter Optionen habe ich schon geschaut. Automatisches Berechnen ist aktiviert.
Antwortento top
#7
Hallo,

es gibt keinen Unterschied zwischen manueller und per Userform eingetragener Werte, wenn nicht per Code irgend etwas ein- oder ausgeschaltet wird.

Gruß Uwe
Antwortento top
#8
Mmmh... Also ich finde nichts und dennoch will es nicht. Ich füge dann doch mal meinen Code und die Datei bei. Mit Sicherheit muss ich den noch aufräumen. Ich will auch gar nicht erst behaupten, dass ich hier viel selber "programmiert" hätte. Dafür fehlt mir dann doch noch das Verständnis... Hoffe Ihr könnt mal drüber schauen und vielleicht findet wer das Problem.

Schon jetzt vielen Dank!!!

Code:
Option Explicit
Dim rngFind As Range


Private Sub CommandButton10_Click() 'Formular löschen!######
Dim ctrElement As Control

  For Each ctrElement In Controls
    Select Case TypeName(ctrElement)
      Case "TextBox": ctrElement = ""
      Case "ListBox": ctrElement = ""
    End Select
  Next
  
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False
CommandButton9.Visible = True
CommandButton18.Visible = False

TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False

ListBox1.Clear

End Sub

Private Sub CommandButton11_Click() 'Formular löschen!######
Dim ctrElement As Control

  For Each ctrElement In Controls
    Select Case TypeName(ctrElement)
      Case "TextBox": ctrElement = ""
      Case "ListBox": ctrElement = ""
    End Select
  Next
  
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False


TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox27.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False
TextBox28.Visible = False

ListBox1.Clear

End Sub

Private Sub CommandButton12_Click() 'Formular löschen!######
Dim ctrElement As Control

  For Each ctrElement In Controls
    Select Case TypeName(ctrElement)
      Case "TextBox": ctrElement = ""
      'Case "ListBox": ctrElement = ""
    End Select
  Next
  
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False

TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False

ListBox1.Clear

End Sub


Private Sub CommandButton13_Click()   'Änderungen an Daten speichern


'
'   ändern
'

Dim lLetzte  As Long
Dim ctrElement As Control

   If TextBox27.Text = "" Then
      MsgBox "Sie müssen Aktenzeichen eingeben - Danke.", _
         48, "   Hinweis für " & Application.UserName
      TextBox27.SetFocus
      Exit Sub
   End If
   If TextBox28.Text = "" Then
      MsgBox "Sie müssen einen Namen eingeben - Danke.", _
         48, "   Hinweis für " & Application.UserName
      TextBox28.SetFocus
      Exit Sub
   End If
  
   If TextBox29.Text = "" Then
      MsgBox "Sie müssen einen Vornamen eingeben - Danke.", _
         48, "   Hinweis für " & Application.UserName
      TextBox28.SetFocus
      Exit Sub
   End If
  
'
'   die Daten sind geprüft und können in die Tabelle eingetragen werden
'
   Application.ScreenUpdating = True

   With Worksheets("Daten_WS")
      
      
      rngFind.Offset(0, 1).Value = WorksheetFunction.Proper(TextBox27.Text)
      rngFind.Offset(0, 2).Value = WorksheetFunction.Proper(TextBox28.Text)
      rngFind.Offset(0, 3).Value = WorksheetFunction.Proper(TextBox29.Text)
      rngFind.Offset(0, 4).Value = WorksheetFunction.Proper(TextBox30.Text)
      rngFind.Offset(0, 5).Value = WorksheetFunction.Proper(TextBox31.Text)
      rngFind.Offset(0, 6).Value = WorksheetFunction.Proper(TextBox32.Text)
      rngFind.Offset(0, 7).Value = WorksheetFunction.Proper(TextBox33.Text)
      rngFind.Offset(0, 8).Value = WorksheetFunction.Proper(TextBox34.Text)
      rngFind.Offset(0, 9).Value = WorksheetFunction.Proper(TextBox35.Text)
      rngFind.Offset(0, 10).Value = WorksheetFunction.Proper(TextBox36.Text)
      rngFind.Offset(0, 11).Value = WorksheetFunction.Proper(TextBox37.Text)
      rngFind.Offset(0, 12).Value = WorksheetFunction.Proper(TextBox38.Text)
      rngFind.Offset(0, 13).Value = WorksheetFunction.Proper(TextBox39.Text)
      rngFind.Offset(0, 14).Value = WorksheetFunction.Proper(TextBox40.Text)
      rngFind.Offset(0, 15).Value = WorksheetFunction.Proper(TextBox41.Text)
    
      lLetzte = IIf(.Range("A65536") <> "", 65536, .Range("A65536").End(xlUp).Row) + 1
      If lLetzte < 2 Then lLetzte = 2
      
      

   End With
  
   'Application.ScreenUpdating = True
  

'Formular Löschen
  For Each ctrElement In Controls
    Select Case TypeName(ctrElement)
      Case "TextBox": ctrElement = ""
      'Case "ListBox": ctrElement = ""
    End Select
  Next
  
'Listbox löschen
ListBox1.Clear

'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
TextBox1.Visible = True
TextBox2.Visible = True
TextBox3.Visible = True
TextBox4.Visible = True
TextBox5.Visible = True
TextBox6.Visible = True
TextBox7.Visible = True
TextBox8.Visible = True
TextBox9.Visible = True
TextBox10.Visible = True
TextBox11.Visible = True
TextBox12.Visible = True
TextBox13.Visible = True
TextBox14.Visible = True
TextBox15.Visible = True
TextBox16.Visible = True

TextBox24.Visible = False
TextBox25.Visible = False
TextBox26.Visible = False
TextBox27.Visible = False
TextBox28.Visible = False
TextBox29.Visible = False
TextBox30.Visible = False
TextBox31.Visible = False
TextBox32.Visible = False
TextBox33.Visible = False
TextBox34.Visible = False
TextBox35.Visible = False
TextBox36.Visible = False
TextBox37.Visible = False
TextBox38.Visible = False
TextBox39.Visible = False
TextBox40.Visible = False
TextBox41.Visible = False

CommandButton9.Visible = False
CommandButton18.Visible = True
CommandButton10.Visible = True
CommandButton11.Visible = True
CommandButton12.Visible = True
CommandButton13.Visible = False
CommandButton6.Visible = False
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False

End Sub


Private Sub CommandButton3_Click()
'Variable deklarieren
Dim letzte_Zeile As Long

With Worksheets("Daten_WS")

'Die letzte beschrieben Zeile in Spalte A ermitteln
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
'Eintrag aus TextBox1 (W-Listen-Nr.) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 1) = TextBox1.Text
'Eintrag aus TextBox2 (Aktenzeichen) in erste frei Zeile  übertragen
.Cells(letzte_Zeile, 2) = TextBox2.Text
'Eintrag aus TextBox3 (Name) in erste frei Zeile  übertragen
.Cells(letzte_Zeile, 3) = TextBox3.Text
'Eintrag aus TextBox4 (Vorname) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 4) = TextBox4.Text
'Eintrag aus TextBox5 (Wohn A/B/C) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 5) = TextBox5.Text
'Eintrag aus TextBox6 (Bescheid vom) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 6) = TextBox6.Text
'Eintrag aus TextBox7 (Bescheid Nr.) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 7) = TextBox7.Text
'Eintrag aus TextBox8 (Widerspruchsrate) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 8) = TextBox8.Text
'Eintrag aus TextBox9 (Rückforderung) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 9) = TextBox9.Text
'Eintrag aus TextBox10 (Widerspruch vom) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 10) = TextBox10.Text
'Eintrag aus TextBox11(Eingang 1. Instanz) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 11) = TextBox11.Text
'Eintrag aus TextBox12 (Eingang 2. Instanz) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 12) = TextBox12.Text
'Eintrag aus TextBox13 (Erledigt am) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 13) = TextBox13.Text
'Eintrag aus TextBox14 (Erledigungsart) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 14) = TextBox14.Text
'Eintrag aus TextBox15 (Standort) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 15) = TextBox15.Text
'Eintrag aus TextBox16 (Vermerk) in erste freie Zelle  übertragen
.Cells(letzte_Zeile, 16) = TextBox16.Text

End With

ClearAll

End Sub

Private Sub CommandButton14_Click()
Unload Me
UserForm4.Show

End Sub

Private Sub CommandButton15_Click()
Unload Me
UserForm1.Show

End Sub

Private Sub CommandButton18_Click()
TextBox1.Visible = False
TextBox2.Visible = False
TextBox3.Visible = False
TextBox4.Visible = False
TextBox5.Visible = False
TextBox6.Visible = False
TextBox7.Visible = False
TextBox8.Visible = False
TextBox9.Visible = False
TextBox10.Visible = False
TextBox11.Visible = False
TextBox12.Visible = False
TextBox13.Visible = False
TextBox14.Visible = False
TextBox15.Visible = False
TextBox16.Visible = False

TextBox24.Visible = True
TextBox25.Visible = False
TextBox26.Visible = False
TextBox27.Visible = True
TextBox28.Visible = True
TextBox29.Visible = True
TextBox30.Visible = True
TextBox31.Visible = True
TextBox32.Visible = True
TextBox33.Visible = True
TextBox34.Visible = True
TextBox35.Visible = True
TextBox36.Visible = True
TextBox37.Visible = True
TextBox38.Visible = True
TextBox39.Visible = True
TextBox40.Visible = True
TextBox41.Visible = True

CommandButton9.Visible = True
CommandButton18.Visible = False
CommandButton10.Visible = False
CommandButton11.Visible = False
CommandButton12.Visible = False
CommandButton13.Visible = True
CommandButton6.Visible = True
End Sub

Private Sub CommandButton5_Click()
If TextBox1.Text = "" Then
'UserForm schließen
Unload UserForm2
Exit Sub
Else
If MsgBox("Den angezeigten Datensatz speichern ?", 36, "Sicherheitsabfrage") = vbYes Then
CommandButton3_Click
End If
Unload UserForm1
End If
End Sub

Private Sub CommandButton1_Click()
Dim sSearch As String

'Datensatz suchen

If TextBox1.Text = "" Then
MsgBox "Geben Sie bitte eine W-Listen-Nr. ein !"
Exit Sub

Else
sSearch = TextBox1.Text
Set rngFind = Columns("A:A").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
  If MsgBox("Diese W-Listen-Nr. existiert noch nicht !" & vbCrLf & vbCrLf & "  Möchten Sie eine neue P-Nr. anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
  TextBox1.Text = ""
  TextBox1.SetFocus
  Exit Sub
End If

Else
    TextBox24.Text = rngFind.Offset(0, 0).Value
    TextBox25.Text = rngFind.Offset(0, 1).Value
    TextBox27.Text = rngFind.Offset(0, 1).Value
    TextBox26.Text = rngFind.Offset(0, 2).Value
    TextBox28.Text = rngFind.Offset(0, 2).Value
    TextBox4.Text = rngFind.Offset(0, 3).Value
    TextBox29.Text = rngFind.Offset(0, 3).Value
    TextBox5.Text = rngFind.Offset(0, 4).Value
    TextBox30.Text = rngFind.Offset(0, 4).Value
    TextBox6.Text = rngFind.Offset(0, 5).Value
    TextBox31.Text = rngFind.Offset(0, 5).Value
    TextBox7.Text = rngFind.Offset(0, 6).Value
    TextBox32.Text = rngFind.Offset(0, 6).Value
    TextBox8.Text = rngFind.Offset(0, 7).Value
    TextBox33.Text = rngFind.Offset(0, 7).Value
    TextBox9.Text = rngFind.Offset(0, 8).Value
    TextBox34.Text = rngFind.Offset(0, 8).Value
    TextBox10.Text = rngFind.Offset(0, 9).Value
    TextBox35.Text = rngFind.Offset(0, 9).Value
    TextBox11.Text = rngFind.Offset(0, 10).Value
    TextBox36.Text = rngFind.Offset(0, 10).Value
    TextBox12.Text = rngFind.Offset(0, 11).Value
    TextBox37.Text = rngFind.Offset(0, 11).Value
    TextBox13.Text = rngFind.Offset(0, 12).Value
    TextBox38.Text = rngFind.Offset(0, 12).Value
    TextBox14.Text = rngFind.Offset(0, 13).Value
    TextBox39.Text = rngFind.Offset(0, 13).Value
    TextBox15.Text = rngFind.Offset(0, 14).Value
    TextBox40.Text = rngFind.Offset(0, 14).Value
    TextBox16.Text = rngFind.Offset(0, 15).Value
    TextBox41.Text = rngFind.Offset(0, 15).Value
End If
End If
sSearch = ""

'Änderung Sichtbarkeiten Button und Textbox bei Auslösung "Suchen"
CommandButton1.Visible = False
CommandButton10.Visible = True
CommandButton2.Visible = False
CommandButton11.Visible = True
CommandButton7.Visible = False
CommandButton12.Visible = True
CommandButton9.Visible = False
CommandButton18.Visible = True


TextBox1.Visible = False
TextBox24.Visible = True
TextBox2.Visible = False
TextBox25.Visible = True
TextBox27.Visible = False
TextBox3.Visible = False
TextBox26.Visible = True
TextBox28.Visible = False

End Sub


Private Sub CommandButton2_Click()
Dim sSearch As String
Dim firstAddress
Dim i As Integer

'Datensatz suchen

If TextBox2.Text = "" Then
MsgBox "Geben Sie bitte ein Aktenzeichen ein !"
Exit Sub

Else
sSearch = TextBox2.Text
Set rngFind = Columns("B:B").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
  If MsgBox("Dieses Aktenzeichen existiert noch nicht !" & vbCrLf & vbCrLf & "  Möchten Sie das Aktenzeichen anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
  TextBox2.Text = ""
  TextBox2.SetFocus
  Exit Sub

  End If


Else
i = 0
firstAddress = rngFind.Address
        Do
        
            ListBox1.AddItem
            ListBox1.List(i, 0) = rngFind.Offset(0, -1).Value
            ListBox1.List(i, 1) = rngFind
            ListBox1.List(i, 2) = rngFind.Offset(0, 1).Value
            ListBox1.List(i, 3) = rngFind.Offset(0, 2).Value
          
            
            Set rngFind = Columns("B:B").FindNext(rngFind)
            
            i = i + 1
            
        Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

End If
End If

If ListBox1.ListCount = 2 Then
   TextBox1.Text = rngFind.Offset(0, 0).Value
   TextBox2.Text = rngFind.Offset(0, 1).Value
   TextBox3.Text = rngFind.Offset(0, 4).Value
   TextBox4.Text = rngFind.Offset(0, 5).Value
   TextBox5.Text = rngFind.Offset(0, 2).Value
   TextBox6.Text = rngFind.Offset(0, 5).Value
   TextBox7.Text = rngFind.Offset(0, 6).Value
   TextBox8.Text = rngFind.Offset(0, 7).Value
   TextBox9.Text = rngFind.Offset(0, 8).Value
   TextBox10.Text = rngFind.Offset(0, 9).Value
   TextBox11.Text = rngFind.Offset(0, 10).Value
   TextBox12.Text = rngFind.Offset(0, 11).Value
   TextBox13.Text = rngFind.Offset(0, 12).Value
   TextBox14.Text = rngFind.Offset(0, 13).Value
   TextBox15.Text = rngFind.Offset(0, 14).Value
   TextBox16.Text = rngFind.Offset(0, 15).Value
   TextBox24.Text = rngFind.Offset(0, 0).Value



ListBox1.Clear
End If

'Änderung Sichtbarkeiten Button und Textbox bei Auslösung "Suchen"
CommandButton1.Visible = False
CommandButton10.Visible = True
CommandButton2.Visible = False
CommandButton11.Visible = True
CommandButton7.Visible = False
CommandButton12.Visible = True


TextBox1.Visible = False
TextBox24.Visible = True
TextBox2.Visible = False
TextBox25.Visible = True
TextBox27.Visible = False
TextBox3.Visible = False
TextBox26.Visible = True


End Sub


Private Sub CommandButton7_Click()
Dim sSearch As String
Dim firstAddress
Dim i As Integer

'Datensatz suchen

If TextBox3.Text = "" Then
MsgBox "Geben Sie bitte einen Namen ein !"
Exit Sub

Else
sSearch = TextBox3.Text
Set rngFind = Columns("C:C").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
  If MsgBox("Dieser Name existiert noch nicht !" & vbCrLf & vbCrLf & "  Möchten Sie einen neuen Namen anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
  TextBox3.Text = ""
  TextBox3.SetFocus
  Exit Sub

  End If


Else
i = 0
firstAddress = rngFind.Address
        Do
        
            ListBox1.AddItem
            ListBox1.List(i, 0) = rngFind.Offset(0, -2).Value
            ListBox1.List(i, 1) = rngFind.Offset(0, -1).Value
            ListBox1.List(i, 2) = rngFind
            ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
            
            Set rngFind = Columns("c:c").FindNext(rngFind)
            
            i = i + 1
            
        Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

End If
End If

If ListBox1.ListCount = 1 Then
   TextBox1.Text = rngFind.Offset(0, -2).Value
   TextBox2.Text = rngFind.Offset(0, -1).Value
   TextBox3.Text = rngFind.Offset(0, 0).Value
   TextBox4.Text = rngFind.Offset(0, 1).Value

ListBox1.Clear
End If

'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = False
CommandButton10.Visible = True
CommandButton2.Visible = False
CommandButton11.Visible = True
CommandButton7.Visible = False
CommandButton12.Visible = True

TextBox1.Visible = False
TextBox24.Visible = True
TextBox2.Visible = False
TextBox25.Visible = True
TextBox27.Visible = False
TextBox3.Visible = False
TextBox26.Visible = True


End Sub




Private Sub CommandButton6_Click()  'Formular löschen!######
Dim ctrElement As Control

  For Each ctrElement In Controls
    Select Case TypeName(ctrElement)
      Case "TextBox": ctrElement = ""
      'Case "ListBox": ctrElement = ""
    End Select
  Next
  
'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Visible = True
CommandButton10.Visible = False
CommandButton2.Visible = True
CommandButton11.Visible = False
CommandButton7.Visible = True
CommandButton12.Visible = False

TextBox1.Visible = True
TextBox24.Visible = False
TextBox2.Visible = True
TextBox25.Visible = False
TextBox3.Visible = True
TextBox26.Visible = False

ListBox1.Clear
End Sub


Private Sub CommandButton8_Click()
'UserForm schließen und anderes UserForm starten#####
UserForm2.Hide
UserForm5.Show
'#####
End Sub


Private Sub CommandButton9_Click()

End Sub



Private Sub ListBox1_Click()
Dim sSearch As String

If ListBox1.ListCount > 1 Then
    sSearch = ListBox1.List(ListBox1.ListIndex, 0)
Set rngFind = Columns("A:A").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)

If Not rngFind Is Nothing Then

    TextBox4.Text = rngFind.Offset(0, 3).Value
    TextBox5.Text = rngFind.Offset(0, 4).Value
    TextBox6.Text = rngFind.Offset(0, 5).Value
    TextBox7.Text = rngFind.Offset(0, 6).Value
    TextBox8.Text = rngFind.Offset(0, 7).Value
    TextBox9.Text = rngFind.Offset(0, 8).Value
    TextBox10.Text = rngFind.Offset(0, 9).Value
    TextBox11.Text = rngFind.Offset(0, 10).Value
    TextBox12.Text = rngFind.Offset(0, 11).Value
    TextBox13.Text = rngFind.Offset(0, 12).Value
    TextBox14.Text = rngFind.Offset(0, 13).Value
    TextBox15.Text = rngFind.Offset(0, 14).Value
    TextBox16.Text = rngFind.Offset(0, 15).Value
    TextBox24.Text = rngFind.Offset(0, 0).Value
    TextBox25.Text = rngFind.Offset(0, 1).Value
    TextBox27.Text = rngFind.Offset(0, 1).Value
    TextBox26.Text = rngFind.Offset(0, 2).Value
    TextBox28.Text = rngFind.Offset(0, 2).Value
    TextBox29.Text = rngFind.Offset(0, 3).Value
End If
sSearch = ""

End If

'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton18.Visible = True


End Sub





Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Fehlermeldung, wenn versucht wird, die UserForm über das
'Schließenkreuz oben rechts zu schließen
If CloseMode = 0 Then
    Cancel = 1
    MsgBox "Bitte verlassen Sie die Eingabemaske nur mit der Schaltfläche - Beenden.", _
        vbOKOnly + vbInformation, "Bitte Schaltfläche betätigen."
End If

End Sub

Public Sub UserForm_Initialize()

On Error GoTo EERR
With UserForm1
.Height = 700
.Width = 900
End With

'Variable deklarieren
Dim Wiederholungen As Integer
Sheets("Daten_WS").Select

TextBox1.Text = ""
TextBox1.SetFocus

'Textfelder, Schalter sperren, entsperren und sichtbar und unsichtbar machen
CommandButton1.Default = False
CommandButton10.Visible = False
CommandButton11.Visible = False
CommandButton12.Visible = False

TextBox24.Visible = False
TextBox25.Visible = False
TextBox26.Visible = False
TextBox27.Visible = False
TextBox28.Visible = False
TextBox29.Visible = False
TextBox30.Visible = False
TextBox31.Visible = False
TextBox32.Visible = False
TextBox33.Visible = False
TextBox34.Visible = False
TextBox35.Visible = False
TextBox36.Visible = False
TextBox37.Visible = False
TextBox38.Visible = False
TextBox39.Visible = False
TextBox40.Visible = False
TextBox41.Visible = False

CommandButton13.Visible = False
CommandButton6.Visible = False
CommandButton18.Visible = False
CommandButton17.Visible = False


Exit Sub
EERR:

End Sub

Sub ClearAll()
Dim C As Integer
On Error Resume Next

ListBox1.Clear

For C = 1 To 2
    Me.Controls("ComboBox" & CStr(C)).Text = ""
Next C
For C = 1 To 5
    Me.Controls("TextBox" & CStr(C)).Text = ""
Next C

End Sub


Angehängte Dateien
.xlsm   VBARecht.xlsm (Größe: 65,97 KB / Downloads: 10)
Antwortento top
#9
Hallo,

welche Tabellen sollen gefüllt werden? Und welche Formeln gehen nicht?

Nachtrag: Die Textboxen liefern, wie der Name schon sagt, Text zurück. Durch deine Zellformatierung siehst Du dies aber nicht (der Inhalt ist linksbündig ausgerichtet anstatt rechtsbündig). Nimm eine Umwandlungsfunktion wie CDate.
Gruß Stefan
Win 7 / Office 2007
Antwortento top
#10
Tschuldigung... Noch etwas ungenau meine Frage. Mit dem Code bzw. einem Teil davon, ändere ich Daten auf dem Datenblatt "Daten_WS". Das funktioniert auch. Die Daten werden alle in das Tabellenblatt geschrieben. Auf einem weiteren Tabellenblatt "Statistik" werden nun Daten aus dem Blatt "Daten_WS" ausgelesen bzw. sollen ausgelesen werden. Dies funktioniert eben nicht. Alle Einträge aus den Spalten K, L und M wertet das Blatt nicht aus. Trage ich die Daten so direkt in Daten_WS ein, dann klappt es. Muss ich vielleicht im Userform noch angeben, dass die Textbox Datumsangaben schreiben soll?
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste