PDA

Vollständige Version anzeigen : VBA ist doof :( /// Werte in verschiedenen Spalten suchen und Zeilen kopieren


Felix S.
17.07.2014, 14:43
Ich "darf" mich seit einer Woche mit Excel und VBA beschäftigen. Nur Programmieren gehört so ganz und gar nicht zu meinem Studiengang.

Grundgedanke ist, ich soll eine Datenbank aufbauen. Dazu habe ich im Netz auch schon recht viel Anleitungen und Hilfe gefunden.

Ich habe die Datenbank auch mal angehängt damit ihr wisst von was ich rede und was ich bisher gemacht habe.

Nun stehe ich aber vor einem Problem, was ich seit bald 2 Tagen nicht hin bekomme.

Ich habe eine Userform, in welche der Benutzer insgesammt 3 Werte eintragen muss.

Diese sind.

Traglast [Spalte B]

Greifbereich von [Spalte C]

Greifbereich bis [Spalte D]

Nun soll in dem Sheet "Datenbank" dannach gesucht werden. Bei
Traglast in einem Bereich von Plus/Minus 5 und beim Greifbereich Plus
Minus 10

Ich wollte zu Beginn, dass bei Greifbereich nur ein Wert eingegeben
wird, und die Datenbank durchsucht beide Spalten nach "passenden" Werten
aber soweit komm ich schon mal gar und überhaupt nicht.

Nicht mal eine einfache Suche nach einem Wert und dann die Zeile zu Kopieren bekomme ich hin :'(

Wenn nun in der Datenbank Datensätze gefunden werden, sollen diese in das Sheet "Suchergebnisse" kopiert werden.

Ich hoffe dass es möglich ist auch die Abbildungen zu kopieren.

Wenn eine neue Suche gestartet wird, sollten die vorherigen Suchergebnisse gelöscht werden.

Das Ganze läuft über eine Userform. Diese habe ich auch schon erstellt. Da
habe ich gute Beispiele im Netz gefunden, so dass ich die Datenbankpflege selbst machen konnte

Nun hänge ich gerade wirklich in der Luft :(

Mein Gedankengang den ich nun habe ist der folgende:

Definiere eingegebenen Wert Traglast als TrL

Definiere Greifbereich von als GBv

Definiere Greifbereich bis als GBb

Durchsuche Spalte B nach TrL - 5 bis TrL +10

wenn Ergebnis = True, dann

Durchsuche Spalte C nach GBv - 10 bis GBv +10

wenn Ergebnis = True, dann

Durchsuche Spalte D nach GBb -10 bis GBb+10

wenn Ergebnis = True, dann

kopiere gesamte Zeile in Sheet "Suchergebnis" (aber erst ab Zeile 2)

nächste Zeile in Sheet "Datenbank"

das ganze so lange wiederholen, bis in Spalte A kein Wert vorhanden ist.

und zu guter letzt

Gehe zu Sheet "Suchergebnis" (Das habe ich auch schon geschafft :/ )

1. Weiß ich leider nicht mal ob der Ansatz so richtig ist

2. Ich habe absolut keine Ahnung wie ich das ganze umsetzen soll

Vielleicht kann mir ja von euch jemand weiterhelfen.

Danke schonmal

mfg Felix

Mc Santa
17.07.2014, 14:49
Hallo,

ich würde das ganze über einen Spezialfilter lösen, hier ist ein ganz ähnliches Beispiel:
http://www.ms-office-forum.net/forum/showthread.php?p=1596551#post1596510

Bei diesem Filter kannst du beliebig viele Kriterien einsetzen und so deine Suche abbilden.

VG

Felix S.
17.07.2014, 15:02
Hallo Mc Santa,

habe mir das was du in dem anderen Thread geschrieben hast mal angeschaut aber verstehe auch dort wirklich nur Bahnhof.

Leider muss man mich betrachten wie einen 5 Jährigen der das erste mal VBA sieht. :(

Wie bekomme ich denn diesen "Filter" im Sheet "User die ich Brauche" in meine UserForm?

Ich sehe leider keinen Zusammenhang zu dem UserForm die ich mir zusammengetragen habe.

aloys78
17.07.2014, 15:11
Hall Felix,
Ich habe eine Userform, in welche der Benutzer insgesamt 3 Werte eintragen muss.
Auf Userform2 sehe ich aber nur 2 Textboxen.
Sollen Soll- und Bis-Wert in eine Textbox eingefügt werden ?

Gruß
Aloys

Felix S.
17.07.2014, 15:16
Danke für den Hinweis,

hatte eine Version von gestern erwischt.

Aber geändert hat sich nicht wirklich was, da ich nicht weiterkomme. Sitze nun schon insgesamt seit 15 Stunden am ein und dem selben Problem und sehe kein Land.

:weinen: :weinen:

aloys78
17.07.2014, 16:34
Hallo Felix,

mein Codevorschlag (im VBA-Projektt unter Userform2) mit folgenden Annahmen:
- Start in Quell- und Ziel-Tabelle ab Zeile 3
- Daten in Ziel-Tabelle ab Sp A
Option Explicit

Private Sub CommandButton1_Click()

End Sub

Private Sub CommandButton2_Click() 'Produktsuche - CommandButton in Userform2
Dim q As Long 'Zeilen# Quell-Tabelle
Dim z As Long 'Zeilen# Ziel-Tabelle
Dim LoL As Long 'letzet Eintargung in Datenbank
Dim ws_Z As Worksheet 'Ziel-Tabelle
Dim n As Long 'Zähler gefundene Wert
Dim tw(1 To 3) As Long 'Textbox-Wert

Set ws_Z = Worksheets("Suchergebnisse") 'Ziel-Tabelle
LoL = ws_Z.Cells(Rows.Count, "B").End(xlUp).Row
If LoL > 2 Then ws_Z.Range("A3:A" & LoL).ClearContents 'Ziel-Tabelle leeren

With Me
tw(1) = CLng(.TextBox1) 'Traglast
tw(2) = CLng(.TextBox2) 'von
tw(3) = CLng(.TextBox3) 'bis
End With

With Worksheets("Datenbank")
z = 2
LoL = .Cells(Rows.Count, "B").End(xlUp).Row
For q = 3 To LoL
If Range("B" & q) >= (tw(1) - 5) And Range("B" & q) <= (tw(1) + 10) Then
If Range("C" & q) >= (tw(2) - 10) And Range("C" & q) <= (tw(2) + 10) Then
If Range("D" & q) >= (tw(3) - 10) And Range("D" & q) <= (tw(3) + 10) Then
z = z + 1
Range("B" & q & ":D" & q).Copy Destination:=ws_Z.Range("A" & z) 'Traglast
n = n + 1
End If
End If
End If
Next q
End With
Unload Me
If n > 0 Then
MsgBox n & " Treffer gefunden !"
Else
MsgBox "Keine Treffer gefunden !"
End If
End Sub

Gruß
Aloys

Felix S.
18.07.2014, 07:59
siehe unten

Felix S.
18.07.2014, 08:19
Siehe unten

Felix S.
18.07.2014, 08:42
Habe nun die 2 angehängten Lösungen, aber beide sind suboptimal :/

Lösung 1 ist die von hier, die leider nur die Spalten B bis D aus "Datenbank" in Spalte A bis C in "Suchergebnisse" schreibt.

Lösung 2 hat das das Problem, dass diese immer in einen Fehler läuft und meint die Variablen seien nicht richtig deklariert.


Was beide Lösungen gemeinsam haben, wenn man die Textboxen vom Greifbereich leer lässt (also nur nach der Traglast suchen möchte) , laufen beide in einen Fehler.

aloys78
18.07.2014, 10:06
Hallo Felix,
Habe nun die 2 angehängten Lösungen, aber beide sind suboptimal :/
Lösung 1 ist die von hier, die leider nur die Spalten B bis D aus "Datenbank" in Spalte A bis C in "Suchergebnisse" schreibt
Was möchtest du, eine Lösung oder beklagen ?

Wenn du interessiert bist, dann sag mir lieber, was konkret zu verbessern wäre (was ich ggf in deiner Aufgabenbeschreibung überlesen habe).

Beide Lösungen setzen voraus, dass die Textboxen geprüfte Daten enthalten.
Daher die Empfehlung, die Daten in den Textboxen gleich nach Eingabe zu prüfen.

Und dass du ggf nur die Traglast eingeben möchtest, habe ich so deiner Beschreibung nicht entnommen. Unter "Mein Gedankengan" beschreibst du ja genau, wie der Ablauf sein soll; und so ist es mE in meiner Lösung auch realisiert.

Gruß
Aloys

Felix S.
18.07.2014, 10:14
Ja da sht du recht.

Die Lösung 1, also die von hier funktioniert ja größtenteils. Es werden aber nur die gesuchten Werte ausgegeben. Leider nicht die gesamte Zeile in der die Werte gefunden wurden.

Tut mir leid wenn meine Aussage ein wenig missverständlich rüber kam.

Also konkrete Verbesserungen, wenn wir uns auf Lösung 1 beschränken:

-Ausgabe der ganzen Zeile in das Sheet "Suchergebnisse"
-Die Möglichkeit nur nach Traglast zu suchen (Dies würde ich ggf. dann über
einen weiteren Button realisieren)

Und noch mal 1000 mal Danke für deine Hilfe :)

aloys78
18.07.2014, 11:47
Hallo Felix,

anbei eine neue Version. Aus Zeitgründen konnte ich die nur kurz testen.
Sollte ee noch Probleme geben, melde dich einfach.
Das kopieren der Bilder konnte ich überhaupt nicht testen, da das Tabellenblatt keine enthält.

Gruß
Aloys

Felix S.
18.07.2014, 12:05
Hallo Aloys,

also habe es gerade versucht.

Traglast 50
Greifbereich von 150 bis 200

Dann kommt die MsgBox "1 Treffer gefunden!"

Da auf Ok, dann klappt alles wie es sein soll :)


Wenn ich aber im Anschluss vom Sheet "Suchergebnisse" in die Datenbank zurück gehe und das gleiche erneut mache bekomme ich folgendes


Laufzeitfehler 1004
Die Methode 'Paste' für das Objekt '_Worksheet' ist fehlgeschlagen.

beim debugging bringt er folgendes als Fehler


ws_Z.Paste ws_Z.Range("J" & z)


Genau den gleichen Fehler bringt er mir wenn ich z.B. nur die Traglast eintrage.

Dies hört auch nicht mehr auf.

Wenn ich schließe und neu starte funktioniert es einmal, dann aber nicht mehr.

Kann ich dir für deine Mühen eigentlich irgendwie etwas gutes tun?

Virtuelles Bier schmeckt ja nicht so wirklich :/

aloys78
18.07.2014, 12:32
Hallo Felix,

um diesen Fehler beim Kopieren des Bildes im Moment zu umgehen, bitte folgende Anweisungen auskommentieren.
For Each Bild In Sheets("Datenbank").Shapes
If Bild.TopLeftCell.Address = .Range("$J$" & q).Address Then
'Bild.Copy
' ws_Z.Paste ws_Z.Range("J" & z)
'Exit For
End If
Next


Hast du mit der von mir übersandten Datei getestet ?
Ansonsten bitte Rückmeldung zum Status; ich bin gegen Abend wieder online.

Gruß
Aloys

Felix S.
18.07.2014, 13:06
Hallo Aloys,

habe noch geändert, dass die Datenbanknummer mit übertragen wird

(ja das habe ich ganz allein geschafft Juhuuuu :) )

Das mit dem Bild kopieren habe ich auskommentiert.

So funktioniert es auch.

Ich glaube dass das mit den Bildern daran liegt wie ist in die Datenbank eingetragen werden.

Die Bilder liegen im Netzwerk, das wird auch der Grund sein warum diese bei dir nicht angezeigt werden.

Eingepflegt werden die Bilder wie folgt:

Private Sub CommandButton3_Click()
On Error GoTo ERR
Dim DDDD As String
Dim CCCC As Range
Dim GGGG As Double


Dim SEGG
For Each SEGG In ActiveSheet.Shapes
If Not Intersect(SEGG.TopLeftCell, ActiveCell) Is Nothing Then SEGG.Delete
Next SEGG

Set CCCC = ActiveCell

DDDD = Application.GetOpenFilename(, , "Bild auswählen", , False)
Select Case Right(DDDD, 3)
Case "ani", "apng", "bmp", "cht", "cur", "gif", "ico", "jpg", "JPG", "jpeg", "kml", "png", "rgb", "svg", "svgz", "tif", "tiff", "xmb", "xpm"
ActiveSheet.Pictures.Insert(DDDD).Select
With Selection.ShapeRange
.Top = CCCC.Top + 10
.Left = CCCC.Left + 10
GGGG = WorksheetFunction.Min(CCCC.Width / .Width, CCCC.Height / .Height)
.Height = 110
End With
Selection.Placement = xlMoveAndSize
Selevtion.PrintObject = True
Case Else
MsgBox "Sie haben kein gültiges Bild ausgewählt", 48, "Bild einfügen"
End Select
Exit Sub
ERR:

End Sub


Ich denke mal dass es daran liegen wird.

Mc Santa
18.07.2014, 13:12
Hallo,

passt gerade gar nicht richtig zum Thema, aber bei deinem Select Case vergleichst du die letzten drei Zeichen teilweise mit einem String von vier Zeichen:
Select Case Right(DDDD, 3)
Case "ani", "apng", "bmp", "cht", "cur", "gif", "ico", "jpg", "JPG", _
"jpeg", "kml", "png", "rgb", "svg", "svgz", "tif", "tiff", "xmb", "xpm"


VG

Felix S.
18.07.2014, 13:29
Hmmmm

auch interessant zu wissen :/

ich nehme dann einfach die mit 4 Zeichen raus.

So wie ich es nun gesehen habe sind so oder so nur jpeg's vorhanden

aloys78
18.07.2014, 20:18
Hallo Felix,
ja das habe ich ganz allein geschafft Juhuuuu
Prima !
Die Bilder liegen im Netzwerk, das wird auch der Grund sein warum diese bei dir nicht angezeigt werden.
Das mag sein, nur kann ich das hier nicht nachstellen.

Gruß
Aloys

Felix S.
21.07.2014, 06:32
Hallo Aloys,

ich hoffe mal, dass es so ist wie ich es nun gemacht habe reicht. Ansonsten melde ich mich hier nochmal.


Und nochmal tausend dank an dich und auch an alle anderen. :)