Userform mit Abhängigkeiten

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

For i = 2 To UBound(arr) ' laufe von Zeile 2 bis _ Tabellenende If Application.WorksheetFunction.CountIf(Range(Cells(i, 1), _ Cells(1, 1)), Cells(i, 1).Value) = 1 Then ' wenn Wert das erste _ Mal vorkommt, dann ... arr(az, 0) = Cells(i, 1).Value ' ... Name in Array _ einlesen az = az + 1 ' ... Zähler für _ Arrayfeld plus 1 End If ' Ende der Auswertung Next i

Private Sub ComboBox1_Change() Dim letztezeile As Long Dim i As Long Dim bGef As Boolean 'lade Listbox letztezeile = Sheets("Daten").Cells(Sheets("Daten").Rows.Count, 1).End(xlUp).Row For i = 2 To letztezeile If Sheets("Daten").Cells(i, 1).Value = Me.ComboBox1.Text Then bGef = False For j = 0 To Me.ListBox1.ListCount - 1 'alle Listboxelemente durchlaufen If Me.ListBox1.List(j) = Sheets("Daten").Cells(i, 2).Value Then bGef = True Exit For End If Next j If bGef = False Then Me.ListBox1.AddItem Sheets("Daten").Cells(i, 2).Value End If End If Next i End Sub

Private Sub ListBox2_Click() Dim sSearch As String If ListBox2.ListCount >= 1 Then sSearch = ListBox2.List(ListBox2.ListIndex, 0) Set rngID = Columns("C:C").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues) If Not rngID Is Nothing Then TextBox1.Text = rngID.Offset(0, 1).Value TextBox2.Text = rngID.Offset(0, 3).Value TextBox3.Text = rngID.Offset(0, 4).Value TextBox4.Text = rngID.Offset(0, 5).Value TextBox5.Text = rngID.Offset(0, 6).Value TextBox6.Text = rngID.Offset(0, 7).Value TextBox7.Text = rngID.Offset(0, 8).Value TextBox8.Text = rngID.Offset(0, 9).Value End If sSearch = "" End If ListBox1.Clear End Sub

Private Sub UserForm_Activate() 'Datum und Uhrzeit anzeigen Dim i As Integer, lz As Integer Dim arr As Variant With Sheets(1) ' daten aus blatt Temp (tabelle2) nehmen um combobox1 zu sortieren und doppelte _ werte auszuchliessen !!! shets1 angeben lz = .Cells(Rows.Count, 1).End(xlUp).Row ReDim arr(1 To lz, 1 To 3) For i = 2 To lz arr(i - 1, 1) = .Range("A" & i).Value ' drei spalten in combobox1 zeigen 1. Spalte arr(i - 1, 2) = .Range("d" & i).Value ' drei spalten in combobox1 zeigen 2. Spalte arr(i - 1, 3) = .Range("e" & i).Value ' drei spalten in combobox1 zeigen 3. Spalte Next i End With With ComboBox1 .ColumnHeads = True ' überschrift in combobox1 zeigen .ColumnCount = 3 ' 3 spalten in combobox definieren .List = arr End With ' ende für comobox1 !!! nicht sortieren dann bis hier löschen Label9.Caption = Date Bol = True Do Until Bol = False DoEvents Label10.Caption = Time Loop End Sub

Private Sub CommandButton7_Click() Dim str As String Dim zeile As Long 'end habe leider noch eine Frage bekommt man in der schliessen aktion noch die möglichkeit des abbrechen rein? Habe im Netz schon einiges gefunden aber nichts passt in diesem Code? Bitte nicht lachen er ist _ durch probieren enstanden und funktioniert bis aufs abbrechen ganz gut. Private Sub CommandButton5_Click() If ComboBox1.Text = "" Then 'UserForm schließen Bol = False Unload UserForm1 Exit Sub Else If MsgBox("Den angezeigten Datensatz speichern Achtung sonst Drückst Du nein wird alles _ verworfen und Du hast alles umsonst gemacht Simpi?", 36, "Sicherheitsabfrage") = vbYes Then 'CommandButton3_Click If Not rngID Is Nothing Then 'rngID.Value = ComboBox1.Text rngID.Offset(0, -2).Value = TextBox1.Text rngID.Offset(0, -1).Value = TextBox2.Text rngID.Offset(0, 0).Value = TextBox3.Text rngID.Offset(0, 1).Value = TextBox4.Text rngID.Offset(0, 2).Value = TextBox5.Text rngID.Offset(0, 3).Value = TextBox6.Text rngID.Offset(0, 4).Value = TextBox7.Text rngID.Offset(0, 5).Value = TextBox8.Text Else rngFind.Value = ComboBox1.Text rngFind.Offset(0, -2).Value = TextBox1.Text rngFind.Offset(0, -1).Value = TextBox2.Text rngFind.Offset(0, 0).Value = TextBox3.Text rngFind.Offset(0, 1).Value = TextBox4.Text rngFind.Offset(0, 2).Value = TextBox5.Text rngFind.Offset(0, 3).Value = TextBox6.Text rngFind.Offset(0, 4).Value = TextBox7.Text rngFind.Offset(0, 5).Value = TextBox8.Text End If End If Bol = False Unload UserForm1 End If End Sub PS.: Bitte nicht aufgeben ich schaffe es nicht allein. Lieben lieben Dank Thomas der nervige

Hallo yummi,
ich wünsch Dir erstmal ein ruhigen Tag.
Ich habe das gerade mit dem Zeilen löschen hinbekommen. Habe irgend was aus dem netz zusammengebastelt. aber es geht.
Es bleiben für mich noch die Fragen offen wie bekommt man den "Abbrechen" Butten hin?
Die zweite frage ist wie kann man innerhalb einer userform leichte rechenaufgaben durchführen. ( Ich glaub mit google kriege ich dies noch hin)
Beide Sachen habe ich schon gegoogelt aber sieht noch nicht so gut aus. Ich mache morgen weiter. Bin hunde müde. Anbei ist noch eine interessante Sache. Die Kundenkartei. hier habe ich schon stunden verbracht ich suche eine möglichkeit auszuschliessen das man doppelte dateneinträge machen kann. Wenn ich dies nicht löse kann ich diese Datei einstampfen. Hast du eine Idee? Ich habe schon an ein Butten gedoktort der sollte eine neue Nummer erzeugen, prüfen ob Spalte D,E,F gleich sind dann eine fehlermeldung bringen und wenn alles ok ist die daten in die datenbank schreiben. Nun ja wie Du siehst hat es nicht geklappt. Schaust Du Dir dies mal an?

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

Libe Grüsse Thomas

if FindeEintrag("Name1", "B") 0 then ' oder if FindeEintrag("Name1", _ WandleZahlInBuchstaben(2)) 0 then if FindeEintrag("Vorname1", "C") 0 then if FindeEintrag("Strasse", "D") 0 then if FindeEintrag("Stadt", "E") 0 then if FindeEintrag("WasImmerDuWillst", "F") 0 then u.s.w 'Dann dein code der nach allen Überprüfungen greifen soll end if end if end if end if end if

Hallo,
die abfrage ob der Datensatz schon vorhanden ist klappt super. Jedoch habe ich jetzt das Problem das ich den datensatz auch nicht mer ändern kann. Ich hätte zwei Ideen dafür. Das Macro soll fragen " Achtung dieser Datensatz existiert schon möchtest Du die Änderungen dennoch durchführen?" Die zweite Idee wäre den Anwender aufzufordern " Achtung dieser Datensatz exsistiert schon wenn Sie die Änderungen dennoch durchführen möchten aktivieren Sie das Kontrollkästien" und dann abbruch. Hier müsste dann aber beachtet werden das der Haken im Kontrollkästien nach der Änderung wieder entfern werden muss. Platz für den Haken im Kontrollkästien hätte ich in Spalte B.( Falls man dafür eine Spalte brauch. Tip sucht man im Code nach "neu angelegt" gelangt man schnell zur entsprechenden Stelle ( glaube ich jedenfalls).
Die zweite Idee wäre für mich die bessere.
Lieben dank schon mal
Thomas
Der Ausgangcode:

Private Sub cmd_Daten_uebernehmen_Click()
' Grundlage: Herber, 058499
Dim i% ' textfelder 1 und 2 müssen ausgefüllt sein
Dim bGef As Boolean
Dim sSearch As String
Dim Mldg As String
Dim Stil As VbMsgBoxStyle
Dim Titel As String
Dim Ergebnis As VbMsgBoxResult
Dim rng As Range
Dim intcounter As Integer
For i = 2 To 3 ' textfelder 1 und 2 müssen ausgefüllt sein
'Frage: soll Textbox 1 und 2 oder 2 und 3 gefüllt sein?
'Jetzt wird 2 und 3 geprüft (siehe for Schleife, du kannst aber auch 1,2, und 3 prüfen, nur  _
die for Schleife anpassen)
If Me.Controls("TextBox" & CStr(i)).Text = "" Then ' textfelder 1 und 2 müssen ausgefüllt  _
sein
MsgBox "Alle Felder ausfüllen!" ' textfelder 1 und 2 müssen ausgefüllt sein
Exit Sub ' textfelder 1 und 2 müssen ausgefüllt sein
End If ' textfelder 1 und 2 müssen ausgefüllt sein
Next i ' textfelder 1 und 2 müssen ausgefüllt sein
bGef = False
For i = 2 To 3
If FindEintrag(Me.Controls("Textbox" & CStr(i)).Text, WandleZahlInBuchstaben(i + 2))  0  _
Then
bGef = True
End If
Next i
If bGef = True Then ' doppelte suchen verwende hier Vorname und Nachname, wen ndu was anderes  _
prüfen wilslt einfach Übergabeparameter ändern, kannst du an anderer Stelle auch verwenden bei Bedarf
MsgBox "Der Name '" & TextBox3.Value & " " & TextBox2.Text & "'ist schon vorhanden!" '  _
doppelte suchen
Else
'den Teil habe ich (noch) nicht angefasst
sSearch = ListBox1.Text
If sSearch = "" Then Exit Sub
sSearch = ListBox1.Text
If sSearch = "" Then Exit Sub
If sSearch = "Kd-Nr" Then
Mldg = "Es wurde kein Kunde aus der Liste angewählt oder" _
& " neu angelegt." & Chr(10) & Chr(10) _
& "Es kann keine Datenübernahme vorgenommen werden."
Stil = vbOKOnly + vbInformation
Titel = "Dateneingabekontrolle"
Ergebnis = MsgBox(Mldg, Stil, Titel)
Exit Sub
End If
'so wie oben machen, obwohl das hast du ja schon geprüft
'If FindEintrag Then ' Doppelte ausschliessen
'    MsgBox "Der Name '" & Me.TextBox2.Value & " " & TextBox3 & "'ist schon vorhanden!"
'    Exit Sub
'End If
Set rng = ActiveSheet.Columns("A:A").Find( _
What:=sSearch, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows)
If rng Is Nothing Then
Exit Sub
End If
For intcounter = 1 To 51
Cells(rng.Row, intcounter + 2).Value = Controls("TextBox" & intcounter).Text
Next
Mldg = "Die Eintragungen wurden in die Datenbank übernommen."
Stil = vbOKOnly + vbInformation
Titel = "Dateneingabe - Übernahme - Bestätigung"
Ergebnis = MsgBox(Mldg, Stil, Titel)
End If
End Sub

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Userform mit Abhängigkeiten

26 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

26
Beiträge zum Forumthread

Beiträge zu diesem Forumthread