Office: Suche mit combobox und übernahme der werte in Textbox

Helfe beim Thema Suche mit combobox und übernahme der werte in Textbox in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, mit dem folgenden Code durchsuche ich eine Tabelle nach einem bestimmten Wert, der mit der ComboBox3 selektiert wird und schreibe die... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Oenologe, 7. Juli 2008.

Seite 1 von 2

OENOLOGE

Oenologe

Suche mit combobox und übernahme der werte in Textbox

Hallo zusammen,
mit dem folgenden Code durchsuche ich eine Tabelle nach einem bestimmten Wert, der mit der ComboBox3 selektiert wird und schreibe die Daten in eine neue Tabelle.
Hierzu einige Fragen(3):
Wie kann ich diesen Code so umstricken, dass mit den Werten aus 2 Comboboxen gesucht wird (Combobox1 und combobox3)?
Wie schreibe ich die gefundenen Daten in dafür vorgesehene Textboxen zurück (Textbox1 bis Textbox10)?
Wie lösche ich den Inhalt der Tabelle 2 nach der Suche bzw. dem Eintrag der Daten in die Textboxen, damit bei einer neuen Suche keine Daten mehr in der Tabelle stehen?
Code:

Private Sub CommandButton3_Click()
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim intcb As Integer
Dim zelle As Range
tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = 65536
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
If Cr = 0 Then Cr = 1
sFind = ComboBox3 'Suchbegriff1
For Each wks In Worksheets
If wks.Name = tarWks Then GoTo Exitfor
Set rng = wks.Cells.find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß Oenologe

:)

Oenologe, 7. Juli 2008

#1
JINX

jinx

Moin, Oenologe.

gleichzeitige Suche oder nacheinander? Gleichzeitig mit Verbindung durch ", ":

Code:

sFind = ComboBox1 ", " & ComboBox3 'Suchbegriff1
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wenn die Textboxen nicht umbenannt wurden:
Code:

For bytZähler = 1 to 10
Controls("Textbox" & bytZähler).Value = rng.Value
Next bytZähler
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

tarWks.ClearContents
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

jinx, 9. Juli 2008

#2
OENOLOGE

Oenologe

Hallo jinx,
vielen Dank für die schnelle Antwort. Leider funktioniert das Ganze nicht so richtig
Bei dem Code "sFind = ComboBox1 ", " & ComboBox3 'Suchbegriff1" kommt folgende Fehlermeldung "...erwarte Anweisungsende".
Bei dem Code "For bytZähler = 1 to 10
Controls("Textbox" & bytZähler).Value = rng.Value
Next bytZähler" kommt die Fehlermeldung " Objektvarible oder With Blockvariable nicht festgelegt".
Bei dem Code "tarWks.ClearContents" die Fehlermeldung "ungültiger Bezeichner.
Dann hätt ich noch eine Frage: Wie kann ich die Suche auf die Tabelle "Daten" beschränken?

Gruß
Oenologe

Oenologe, 9. Juli 2008

#3
JINX

jinx

Suche mit combobox und übernahme der werte in Textbox

Moin, Oenologe,

Zu 1.: Da fehlt ein & - und das gehört zwischen die erste Combobox und das ", ":
Code:

sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Zu 2.: Nutzt Du Option Explicit? Dann solltest Du die Variable bytZähler dimensionieren:
Code:

Dim bytZähler as Byte
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

bevor Du sie einsetzt.

Zu 3.: Worksheets(tarWks).ClearContents

Statt mit For Each wks In Worksheets alle Tabellen der Mappe zu durchlaufen, sollte dort die Tabelle angesprochen werden. Ungetestet könnte der Code (bis auf das Löschen der Tabelle2) wie folgt aussehen:

Code:

Private Sub CommandButton3_Click()
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim intcb As Integer
Dim zelle As Range
tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = Rows.Count
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
'''If Cr = 0 Then Cr = 1 ??? Es gibt in Excel keine Zeile 0 ohne Laufzeitfehler bei Ansprache
sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1
Set rng = Worksheets("Daten").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Worksheets("Daten").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
Set rng = Worksheets("Daten").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
'MsgBox erscheint immer, auch wenn
MsgBox prompt:="Keine neue Fundstelle!"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

jinx, 9. Juli 2008

#4
OENOLOGE

Oenologe

Hallo Jinx,
dankee für die schnelle Antwort.
Leider wurde mit dem Code nur ein Problem gelöst.
Die Tabelle 2 wird nun, nach dem die Datensätze in die Userform eingetragen wurden, gelöscht.
Das zweite Problem :Bei dem Code "For bytZähler = 1 to 10
Controls("Textbox" & bytZähler).Value = rng.Value
Next bytZähler" kommt nach wie vor die Fehlermeldung " Objektvarible oder With Blockvariable nicht festgelegt", auch wenn "Dim bytZähler as Byte" eingesetzt wird. Aber ich glaube, dieses Problem kann ich auch mit dem unten aufgeführten Code lösen???

Bei der Suche mit Zwei Comboboxen mit dem Code "sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1" kommt jetzt, nach dem Click auf suchen sofort die Meldung "Keine neue Fundstelle!".

Code:

Private Sub CommandButton3_Click()
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim zelle As Range

tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = Rows.Count
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
sFind = ComboBox3
'sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff 1 und 2
Set rng = Worksheets("Daten").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Worksheets("Daten").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
Set rng = Worksheets("Daten").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
MsgBox prompt:="Keine neue Fundstelle!"

'Aktivieren
Worksheets("Tabelle2").Activate
'Werte in Textbox eintragen, für alle Datensätze gleich
TextBox7.Value = ActiveSheet.Cells(1, 2).Value
TextBox8.Value = ActiveSheet.Cells(1, 3).Value
TextBox9.Value = ActiveSheet.Cells(1, 4).Value
TextBox10.Value = ActiveSheet.Cells(1, 5).Value
TextBox11.Value = ActiveSheet.Cells(1, 6).Value
TextBox12.Value = ActiveSheet.Cells(1, 7).Value
TextBox1.Value = Format(ActiveSheet.Cells(1, 10).Value, "0.00")
TextBox2.Value = Format(ActiveSheet.Cells(1, 11).Value, "0.00")
TextBox4.Value = ActiveSheet.Cells(1, 15).Value
TextBox5.Value = ActiveSheet.Cells(1, 16).Value
TextBox6.Value = ActiveSheet.Cells(1, 17).Value
TextBox233.Value = ActiveSheet.Cells(1, 18).Value
TextBox234.Value = ActiveSheet.Cells(1, 19).Value
TextBox235.Value = ActiveSheet.Cells(1, 20).Value
TextBox236.Value = ActiveSheet.Cells(1, 21).Value
'Erste Zeile füllen
TextBox24.Value = Format(ActiveSheet.Cells(1, 1).Value, "dd.mm.yy")
TextBox52.Value = ActiveSheet.Cells(1, 14).Value
TextBox67.Value = Format(ActiveSheet.Cells(1, 13).Value, "0.00")
TextBox82.Value = Format(ActiveSheet.Cells(1, 24).Value, "dd.mm.yy")
TextBox97.Value = ActiveSheet.Cells(1, 25).Value
TextBox112.Value = ActiveSheet.Cells(1, 26).Value
TextBox127.Value = ActiveSheet.Cells(1, 27).Value
TextBox142.Value = ActiveSheet.Cells(1, 28).Value
TextBox172.Value = ActiveSheet.Cells(1, 30).Value
TextBox187.Value = ActiveSheet.Cells(1, 31).Value
TextBox202.Value = ActiveSheet.Cells(1, 32).Value
TextBox217.Value = ActiveSheet.Cells(1, 33).Value
TextBox232.Value = ActiveSheet.Cells(1, 34).Value

Worksheets(tarWks).Cells.ClearContents

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Oenologe, 10. Juli 2008

#5
JINX

jinx

Moin, Oenologe,

Du solltest Dich bitte erneut um die Vervollständigung der Registrierung kümmern und eine Beispielmappe zur Verdeutlichung anhängen - mit dem Code bist Du meiner Meinung nach wieder genauso weit wie zu Beginn Deiner ersten Frage (und da konnte ich Dir leider auch nicht helfen): ich weiß nicht, was in den Kombinationsfeldern steht und gesucht werden soll, ich weiß nicht, was in welche Textboxen geschrieben werden soll, die Fehlermeldung " Objektvariable oder With Blockvariable nicht festgelegt" wird gegeben. aber kein Hinweis darauf, wo und wie der Code eingesetzt wird und die Meldung hervorruft...

jinx, 10. Juli 2008

#6
ACOLON

Acolon

Hallo Jinx,
Du hast ja Recht mit der Vervollständigung der Registrierung aber es funktioniert nicht so wie ich das will, deshalb melde ich mich mit meiner privaten Registrierung.
Beispieldatei ist beigefügt.
Bei dem unten angefügten Code funktioniert die Suche mit den Werten von zwei comboboxen nicht. Bei der Suche mit Zwei Comboboxen mit dem Code "sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1" kommt jetzt, nach dem Click auf suchen sofort die Meldung "Keine neue Fundstelle!".
Der Code befindet sich in der Userform2, zugehörige Schaltfläche "Abfrage Quellfläche".
Code:

Private Sub CommandButton3_Click()
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim zelle As Range

tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = Rows.Count
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
sFind = ComboBox3
'sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff 1 und 2
Set rng = Worksheets("Daten").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Worksheets("Daten").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
Set rng = Worksheets("Daten").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
MsgBox prompt:="Keine neue Fundstelle!"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ein weiteres Problem ist dazugekommen.
Der Code befindet sich in Userform1, zugehörige Schaltfläche "Antrag erfassen". Hier will ich jedem neu erfassten Datensatz eine fortlaufende Nummer zuteilen, damit ich nacher den jeweiligen Datensatz finden kann.
Mit dem unten aufgeführten Code-Schnippsel wird eine irgendeine vierstellige Zahl ausgegeben.
Code:

Private Sub CommandButton2_Click()
Dim LngNeueReihe As Long
'Aktivieren
With Sheets("Daten")
If .Cells(Rows.Count, 48).End(xlUp) = "ID" Then 'wenn noch kein Datensatz vorhanden
.Cells(Rows.Count, 48).End(xlUp).Offset(1, 0) = 1 'ID 1 vergeben
Else 'wenn schon Datensätze vorhanden
'unterste ID um 1 erhöhen und für den neuen Datensatz verwenden
.Cells(Rows.Count, 48).End(xlUp).Offset(1, 0) = .Cells(Rows.Count, 1).End(xlUp) + 1
End If
Worksheets("Daten").Activate.....
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielen Dank für die Hilfe und die aufgebrachte Geduld!

Gruß
Oenologe
Acolon

Acolon, 10. Juli 2008

#7
JINX

jinx

Suche mit combobox und übernahme der werte in Textbox

Moi, Oenologe/Acolon,

auf dem linken Fuß erwischt - ich werde Dich um ein wenig Geduld bitten müssen, da ich wohl erst im Laufe des heutigen Nachmittags dazu kommen werde, mir die Mappe in Ruhe anzusehen. Ich melde mich wieder.

jinx, 10. Juli 2008

#8
JINX

jinx

Moin, Oenologe/Acolon,

nach wie vor halte ich eine vorgegebene Anzahl von Textboxen zum Einfügen von evtl. nicht vorhandenen Datensätzen für mehr als suboptimal. Ein Datensatz kann in Textfeldern dargestellt werden, für den Rest würde ich (ich wiederhole mich da gerne) ein Listenfeld verwenden (was noch den Vorteil einer Anpassung per Laufleiste bei mehr als 14 Datensätzen hätte *wink.gif*)

Um den Bereich der Textboxen habe ich mich bisher noch nicht gekümmert - kommt vielleicht noch (deshalb fehlt dieser Teil auch im Code):

Code:

Private Sub CommandButton3_Click()
'Sucht in der Tabelle Daten nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim zelle As Range
Dim lngCounter As Long
Dim dblWert As Double

tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = Rows.Count
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
sFind = ComboBox3
'sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1
Set rng = Worksheets("Daten").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If lngCounter = 0 Then
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then Exit Sub
End If
Worksheets("Daten").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
lngCounter = lngCounter + 1
Set rng = Worksheets("Daten").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If

If lngCounter = 0 Then
MsgBox "Keine neue Fundstelle!"
Else
MsgBox "Es wurden " & lngCounter & " Datensätze kopiert.", vbInformation, "Anzahl kopierte DS"
End If
...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

...

With Worksheets(tarWks)
For lngCounter = 1 To .Cells(Rows.Count, 13).End(xlUp).Row
dblWert = dblWert + .Cells(lngCounter, 13).Value
Next lngCounter
.Cells.ClearContents
End With

TextBox53.Value = Format(dblWert, "0.00")

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

jinx, 11. Juli 2008

#9
JINX

jinx

Oenologe/Acolon,

die 4 ersten Zeilen der Textboxen habe ich umbenannt (die weiteren umzubenennen überlasse ich Dir: jeweils zweistellig für die laufende Nummer des Vorkommens in der Zeile und zweistellig für das Vorkommen in der Spalte: TextBox0101 kennzeichnet die linke obere Textbox des Datenbereiches, Textbox1314 sollte später die letzte rechts unten kennzeichnen).

Ein wenig wurde am Code herumgeschraubt, um das Einlesen in die Textboxen im unteren Bereich durch eine Schleife zu ermöglichen. Vielleicht solltest Du Dir überlegen, die Schaltflächen oberhalb des Bereiches der Label und der Textboxen für die Anzeigen zu setzen (das Summenfeld auch) und dann die UserForm je nach Anzahl der gefundenen Datensätze in der Höhe angepasst darzustellen (beim Aufruf also immer ohne den unteren Bereich der dann noch leeren Textboxen).

Code:

Private Sub CommandButton3_Click()
'Sucht in der Tabelle Daten nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim zelle As Range
Dim lngCounter As Long
Dim dblwert As Double

tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = Rows.Count
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
sFind = ComboBox3
Set rng = Worksheets("Daten").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If lngCounter = 0 Then
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then Exit Sub
End If
Worksheets("Daten").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
lngCounter = lngCounter + 1
Set rng = Worksheets("Daten").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If

If lngCounter = 0 Then
MsgBox "Keine neue Fundstelle!"
Else
MsgBox "Es wurden " & lngCounter & " Datensätze kopiert.", vbInformation, "Anzahl kopierte DS"
End If

'Aktivieren
With Worksheets(tarWks)
'Werte in Textbox eintragen
TextBox7.Value = .Cells(1, 2).Value
TextBox8.Value = .Cells(1, 3).Value
TextBox9.Value = .Cells(1, 4).Value
TextBox10.Value = .Cells(1, 5).Value
TextBox11.Value = .Cells(1, 6).Value
TextBox12.Value = .Cells(1, 7).Value
TextBox1.Value = Format(.Cells(1, 10).Value, "0.00")
TextBox2.Value = Format(.Cells(1, 11).Value, "0.00")
TextBox4.Value = .Cells(1, 15).Value
TextBox5.Value = .Cells(1, 16).Value
TextBox6.Value = .Cells(1, 17).Value
TextBox233.Value = .Cells(1, 18).Value
TextBox234.Value = .Cells(1, 19).Value
TextBox235.Value = .Cells(1, 20).Value
TextBox236.Value = .Cells(1, 21).Value

' Schleife zum füllen
For lngCounter = 1 To .Cells(.Rows.Count, 13).End(xlUp).Row
' Abbruchbedingung, da zur Zeit nur die ersten 4 Zeilen der Textboxen umbenannt wurden
If lngCounter > 4 Then
MsgBox "Nur die ersten 4 Reihen der Textboxen sind umbenannt.", vbCritical
Exit For
End If
dblwert = dblwert + .Cells(lngCounter, 13).Value
controls("TextBox01" & Right("0" & lngCounter, 2)).Value = Format(.Cells(lngCounter, 1).Value, "dd.mm.yy")
controls("TextBox02" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 14).Value
controls("TextBox03" & Right("0" & lngCounter, 2)).Value = Format(.Cells(lngCounter, 13).Value, "0.00")
controls("TextBox04" & Right("0" & lngCounter, 2)).Value = Format(.Cells(lngCounter, 24).Value, "dd.mm.yy")
controls("TextBox05" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 25).Value
controls("TextBox06" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 26).Value
controls("TextBox07" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 27).Value
controls("TextBox08" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 28).Value
controls("TextBox09" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 31).Value
controls("TextBox10" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 32).Value
controls("TextBox11" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 33).Value
controls("TextBox12" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 34).Value
controls("TextBox13" & Right("0" & lngCounter, 2)).Value = .Cells(lngCounter, 48).Value
Next lngCounter
.Cells.ClearContents
End With

TextBox53.Value = Format(dblwert, "0.00")

End Sub

'Private Sub TextBox53_Enter()
''Textboxen in Ziffern umwandeln und addieren
' Dim intTB As Integer
'
' TextBox53 = 0 'Wert vorher auf 0 setzen - wenn gewünscht !
' For intTB = 53 To 67
' With controls("TextBox" & intTB)
' If .Value = "" Then .Value = 0
' TextBox53.Value = Format(CDbl(TextBox53.Value) + CDbl(.Value), "0.00")
' End With
' Next
'End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Als Anhang einmal die Mappe im 2007-Format und einmal als gezippte 97-2003 Arbeitsmappe - für den Zwischenstand... *wink.gif*

jinx, 12. Juli 2008

#10
ACOLON

Acolon

Hallo zusammen,
vielen Dank für die bisherige Hilfe!!

Für ein Problem habe ich immer noch keine Lösung.
Der unten aufgeführte Code funktioniert nur mit einem Suchbegriff.
Er sollte aber unbedingt mit zwei Suchbegriffen funktionieren (Code eine Zeile darunter). Kann mir da vielleicht irgendjemand helfen???

Code:

Private Sub CommandButton3_Click()
'Sucht in der Tabelle Daten nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim Cr As Long, tarWks As String
Dim zelle As Range
Dim lngCounter As Long
Dim dblWert As Double

tarWks = "Tabelle2" 'Name_der_Zieltabelle
Cr = Rows.Count
If Worksheets(tarWks).Cells(Cr, 1) = "" Then
Cr = Worksheets(tarWks).Cells(Cr, 1).End(xlUp).Row
End If
sFind = ComboBox3
'sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1
Set rng = Worksheets("Daten").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If lngCounter = 0 Then
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion + vbDefaultButton2) = vbNo Then Exit Sub
End If
Worksheets("Daten").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(Cr)
Cr = Cr + 1
lngCounter = lngCounter + 1
Set rng = Worksheets("Daten").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
.......
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Dann habe ich noch ein zweites Problem.
In einer Textbox1 steht ein Buchstabe "A" mit diesem möchte ich in einer Tabelle "Antiresistenzstrategie" nach Mitteln mit dem gleichen Buchstaben suchen und diese Mittel in einer Listbox anzeigen, wenn die Textbox leer bleibt, dann soll auch in der Listbox nichts angezeigt werden.
Mit dem unten angeführten Code wird die Listbox immer mit den kompletten Daten der Tabelle "Antiresistenzstrategie" angezeigt.
Code:

Private Sub UserForm_Initialize()
Dim intz As Integer
Dim intlB As Integer
Dim Tabelle As Worksheet
Dim tbl As Worksheet

Set Tabelle = Worksheets("Antiresistenzstrategie")
intlB = 0

With PSM_Kurzbeschreibung
.ListBox1.ColumnCount = 5
.ListBox1.ColumnWidths = "150;150"
.ListBox1.ForeColor = RGB(0, 0, 255)
.ListBox1.Font.Bold = True

For intz = 1 To Tabelle.UsedRange.Rows.Count
.ListBox1.AddItem Tabelle.Cells(intz, 1).Value
.ListBox1.Column(1, intlB) = Tabelle.Cells(intz, 2).Value

intlB = intlB + 1
Next intz
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit freundlichem Gruß
Acolon

Acolon, 15. Juli 2008

#11
JINX

jinx

Moin, Acolon,

dann musst Du innerhalb Deiner Tabelle auch eine Spalte schaffen, in der sich genau der aus diesen beiden CBs zusammengesetzte Suchbegriff finden lässt. Ansonsten läuft es so, wie ich es schon in eiern PN dargestellt habe: Suche nach dem ersten Suchbegriff (z.B. in Spalte C), bei Fundstelle Prüfung in Spalte F, ob der zweite Suchbegriff dort gefunden wird: ja, dann kopieren, nein, dann weitersuchen in Spalte C.

jinx, 15. Juli 2008

#12
OENOLOGE

Oenologe

Suche mit combobox und übernahme der werte in Textbox

Hallo Jinx,
vielen Dank für die Antwort.
Ich habe die Spalte (Spalte AB) erstellt und die Werte aus den beiden Ursprungsspalten dort eingefügt, Trennzeichen ist ein";". Das sieht dann so aus "Mittel,Wirkstoff". Jetzt stehe ich etwas auf dem Schlauch, ist dann der folgende Code richtig für die Suche?
Code:

Private Sub CommandButton3_Click()
'Sucht in der Tabelle Daten nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim z As Long, tarWks As String
Dim zelle As Range

tarWks = "Zwischenhalt" 'Name_der_Zieltabelle
cr = Rows.Count
If Worksheets(tarWks).Cells(cr, 1) = "" Then
cr = Worksheets(tarWks).Cells(cr, 1).End(xlUp).Row
End If

sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1 und 2
Set rng = Worksheets("Rebschutzmittel").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Worksheets("Rebschutzmittel").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
cr = cr + 1
Set rng = Worksheets("Rebschutzmittel").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
MsgBox prompt:="Keine neue Fundstelle!"
......
End sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der funktioniert so aber auch nicht. Oder, kannst Du mir auf die Sprünge helfen, welchen Code muss ich dafür einsetzen?

Wenn ich schon beim Fragen bin, dann hier noch drei kleine Fragen*grins .

Code:

Worksheets("Antiresistenzstrategie").Activate
With ActiveSheet.Columns("a:b")

Set rngfound = .Find(what:=TextBox22.Text, LookIn:=xlValues, lookat:=xlWhole)
If rngfound Is Nothing Then
MsgBox "Kein Datensatz gefunden"
Exit Sub
End If
Set rngfound = .Find(what:=TextBox24.Text, LookIn:=xlValues, lookat:=xlWhole)
If rngfound Is Nothing Then
MsgBox "Kein Datensatz gefunden"
Exit Sub
End If

ListBox1.Clear
strfirstadress = rngfound.Address(0, 0)
Do
ListBox1.AddItem .Cells(rngfound.Row, "A")
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(rngfound.Row, "b")
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(rngfound.Row, "c")
Set rngfound = .FindNext(rngfound)
Loop Until rngfound.Address(0, 0) = strfirstadress
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Code funktioniert so gut, in der Listbox werden aber alle Daten dargestellt, also auch die, die mehrfach vorkommen.
Wie kann man mehrfach Einträge in der Listbox vermeiden?

Wie kann man in einer Combobox erreichen, dass nur Werte im Dropdown-Menü erscheinen die zu den Werten einer anderen Combobox passen?

Wie vermeidet man doppelte Einträge und Leerzeilen in Comboboxen?

Ich hoffe, ich gehe Dir nicht zu arg auf die Nerven.
Ansonsten bitte ich um Verständnis für einen blutigen Anfänger in Sachen VBA.

Mit freundlichem Gruß

Oenologe

Oenologe, 17. Juli 2008

#13
JINX

jinx

Moin, Oenologe,

in Deiner zur Verfügung gestellten Mappe gibt es keine Tabellen "Rebschutzmittel" bzw. "Zwischenhalt" - wie soll ich also etwas beantworten können, von dem ich gar nicht weiß, was dort steht und warum es eventuell nicht funktionieren könnte? Ich sehe in dem Fall nicht hell, sondern eher dunkel. *wink.gif*

Wie kann man mehrfach Einträge in der Listbox vermeiden?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich verstehe Dein Vorgehen nicht: etwas aus einer Textbox suchen und ohne Auswertung etwas aus einer anderen Textbox suchen, aber dann die Merkmale der zweiten Fundstelle auswerten? Da ich nur mutmaßen kann, würde ich ein Vorgehen per Autofilter vorschlagen bzw. das Vorgehen anlegen an Werte in Tabellenblatt zählen wenn Name in Spalte C. Damit sollten die Werte nur einmal auftauchen...

Wie kann man in einer Combobox erreichen, dass nur Werte im Dropdown-Menü erscheinen die zu den Werten einer anderen Combobox passen?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Woher weiß ich das und kann dies VBA in irgendeiner Form mitteilen? Es muss doch eine Beziehung oder eine Nachschlagetabelle geben, auf die man sich dazu beziehen kann. Dann kann im Change-Ereignis der einen CB festgelegt werden, welche anderen Werte in der nächsten CB zu erscheinen haben. Dies sollte zuerst in einer Tabelle mit entsprechenden Überschriften ausgearbeitet werden (wobei die Überschriften auch die vergebenen Namen für die Bereiche sein können).

Wie vermeidet man doppelte Einträge und Leerzeilen in Comboboxen?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bereiche dynamisch beim Befüllen der CB angeben, für die Übernahme der Werte WorksheetFunction.CountIf(Range("$A$1:$A" & lngCounter), Range("A" & lngCounter)) = 1 verwenden.

jinx, 17. Juli 2008

#14
ACOLON

Acolon

Hallo Jinx,
Sorry, ist mein Fehler, man sollte etwas nachdenken bevor man eine Anfrage im Forum stellt. Die Fragen beziehen sich auf ein neues Projekt.

Ich habe die Spalte (Spalte AB) erstellt und die Werte aus den beiden Ursprungsspalten dort eingefügt, Trennzeichen ist ein",". Das sieht dann so aus "Mittel,Wirkstoff". Jetzt stehe ich etwas auf dem Schlauch, ist dann der folgende Code richtig für die Suche?
Code:

Private Sub CommandButton3_Click()
'Sucht in der Tabelle Daten nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definiete Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim z As Long, tarWks As String
Dim zelle As Range

tarWks = "Zwischenhalt" 'Name_der_Zieltabelle
cr = Rows.Count
If Worksheets(tarWks).Cells(cr, 1) = "" Then
cr = Worksheets(tarWks).Cells(cr, 1).End(xlUp).Row
End If

sFind = ComboBox1 & ", " & ComboBox3 'Suchbegriff1 und 2
Set rng = Worksheets("Rebschutzmittel").Cells.Find(what:=sFind, _
lookat:=xlWhole, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
If MsgBox("Weiter und kopieren", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Worksheets("Rebschutzmittel").Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
cr = cr + 1
Set rng = Worksheets("Rebschutzmittel").Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Exitfor:
MsgBox prompt:="Keine neue Fundstelle!"
......
End sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der funktioniert so aber auch nicht. Oder, kannst Du mir auf die Sprünge helfen, welchen Code muss ich dafür einsetzen?

Zu den anderen Fragen:

Code:

Worksheets("Antiresistenzstrategie").Activate
With ActiveSheet.Columns("a:b")

Set rngfound = .Find(what:=TextBox22.Text, LookIn:=xlValues, lookat:=xlWhole)
If rngfound Is Nothing Then
MsgBox "Kein Datensatz gefunden"
Exit Sub
End If
Set rngfound = .Find(what:=TextBox24.Text, LookIn:=xlValues, lookat:=xlWhole)
If rngfound Is Nothing Then
MsgBox "Kein Datensatz gefunden"
Exit Sub
End If

ListBox1.Clear
strfirstadress = rngfound.Address(0, 0)
Do
ListBox1.AddItem .Cells(rngfound.Row, "A")
ListBox1.List(ListBox1.ListCount - 1, 1) = .Cells(rngfound.Row, "b")
ListBox1.List(ListBox1.ListCount - 1, 2) = .Cells(rngfound.Row, "c")
Set rngfound = .FindNext(rngfound)
Loop Until rngfound.Address(0, 0) = strfirstadress
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Code funktioniert so gut, in der Listbox werden aber alle Daten dargestellt, also auch die, die mehrfach vorkommen. Ausprobieren mit "Universalis" als Mittel
Wie kann man mehrfach Einträge in der Listbox vermeiden?

Wie kann man in einer Combobox erreichen, dass nur Werte im Dropdown-Menü erscheinen die zu den Werten einer anderen Combobox passen?
Folgendes Szenario: In der Spalte A der Tabelle "Rebschutzmittel" stehen die Bezeichnung für die Krankheiten und Schädlinge, in Spalte B die dazugehörigen Mittel. Wenn ich jetzt mit der Combobox 3ein Begriff auswähle z.B. Peronospora, dann soll in der Combobox1_Dropdownliste nur die Mittel erscheinen bei denen der Begriff Peronospora in der Spalte A steht.

Wie vermeidet man doppelte Einträge und Leerzeilen in Comboboxen?
Durch die "RowSource" Auswahl aus der Tabelle "Rebschutzmittel" Spalte a in der Eigenschaft z.B. der Combox3 erscheinen in der Dropdownliste der ComboBox natürlich alle Einträge. Wie kann das vermieden werden.
Wenn ich mit einer "Hilstabelle" arbeite, dann stimmen die Zuordnungen nicht mehr.

Mit freundlichem Gruß

Oenologe/Acolon

Acolon, 17. Juli 2008

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 2

Thema:

Suche mit combobox und übernahme der werte in Textbox

Die Seite wird geladen...

Suche mit combobox und übernahme der werte in Textbox - Similar Threads - Suche combobox übernahme
suche Möglichkeit Outlook möglichst mit allen Einstellungen auf neuen Rechner zu übernehemen
in Microsoft Outlook Hilfe
suche Möglichkeit Outlook möglichst mit allen Einstellungen auf neuen Rechner zu übernehemen: Hallo zusammen, ich bin gerade dabei meiner Schwiegermama einen neuen PC einzurichten. Klappt auch alles soweit gut bis auf Outlook (daß ich leider selber nicht nutze und daher null Erfahrung...
Datum Suchen
in Microsoft Excel Hilfe
Datum Suchen: Hallo! Situation: In einem Formular wird ein Name einer Produktionsmaschine eingetragen. In einem anderem Textfeld steht das Lieferdatum. Bei klicken auf "Speichern" wird das Lieferdatum...
wenn Suchen oder
in Microsoft Excel Hilfe
wenn Suchen oder: Hallo zusammen, es klemmt gerade bei der nachfolgenden Formel im blau markierten Teil, wenn ich das ODER verwende. Kann mir bitte jemand helfen ? =WENN(B101="";"Lieferort /...
Postfachsuche funktioniert nur bei einem Postfach nicht...
in Microsoft Outlook Hilfe
Postfachsuche funktioniert nur bei einem Postfach nicht...: Hallo zusammen, ich (Freelancer) verwende mehrere Rechner und Laptops. Auf zwei Laptops ist Office 365 Fam. installiert. Auf einem Rechner und zwei Laptops ist Office 365 Business Standard...
ComboBox Dynamische Suche
in Microsoft Excel Hilfe
ComboBox Dynamische Suche: Hallo liebes Forum, ich bin gerade bei einem Projekt und möchte mal wissen, ob folgendes zu realisieren ist. Ich habe eine Liste. Als Beispiel im Anhang mal die Liste der 100 reichsten Deutschen....
ComboBox Eintrag suchen
in Microsoft Excel Hilfe
ComboBox Eintrag suchen: Moin moin Bin wieder auf suche nach Hilfe. Suche den Inhalt einer ComboBox. Folgendes Problem taucht auf, wenn ich einen Inhalt in der Spalte habe mit Elbe und einen Inhalt mit Engelbert, zeigt...
Excel VBA Suche mit Hilfe von Comboboxen in Anhängigkeiten
in Microsoft Excel Hilfe
Excel VBA Suche mit Hilfe von Comboboxen in Anhängigkeiten: Hallo Ich bin unerfahren im Bereich VBA und versuche mich aber grade an einer (für mich) sehr komplexen Aufgabe. Ich würde gerne eine Suche über eine UserForm mit 4 Comboboxen erstellen....

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden