Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 18:04:29
18.04.2024 16:33:24
Anzeige
Archiv - Navigation
1364to1368
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Daten aus anderer Datei in UF ziehen
06.06.2014 16:14:21
Spenski
aloha

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

<--- abgespeckte version
ich habe einer userform mit der ich daten in eine andere mappe speicher (immer die nächste freie zeile)
in spalte A steht der kundenname
jetzt möchte ich die möglichkeit haben in der UF in einer textbox ( oder Listbox , aber lieber Textbox um fehler der USer zu vermeiden) einen angelegten kunden einzugeben und per buttonclick die daten in die UF zu laden (so wie sie auch angelegt wurden)
wenn ich jetzt in den daten was änder und wieder anlege soll er den alten datensatz überschreiben.
heisst: wenn Kundenname in Spalte A vorkommt dann komplette zeile mit den daten überschreiben ; sonst nächste freie zeile
vielleicht hat ja einer eine idee , wäre echt dankbar.
hab sowas auch schonmal gesehen in form einer lagerbestandsverwaltung aber ich finds nicht wieder...weiter googlen und hier hoffen :D
danke
christian

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten aus anderer Datei in UF ziehen
06.06.2014 18:53:31
Spenski
so nach paar std googlen nix gefunden :(
es müsste doch eigentlich über nen sverweis gehen oder?

AW: Daten aus anderer Datei in UF ziehen
06.06.2014 19:10:21
Christian
Hallo Christian,
mit meinen geringen VBA Kenntnissen mal folgender Ansatz:
Private wkstab1 As Worksheet, zeiletab1 As Long
Private Sub UserForm_Initialize()
Set wkstab1 = ActiveWorkbook.Worksheets("Tabelle1")
zeiletab1 = wkstab1.Range("A:A").Find(what:="*", After:=[A1], LookIn:=xlValues,  _
SearchDirection:=xlPrevious).Row
End Sub
Private Sub CommandButton1_Click()
Dim FrageKundeneu&
Dim BereichKunde As Range
Dim zeileKunde As Long
Set BereichKunde = wkstab1.Range("A:A").Find(TextBox4, lookat:=xlWhole)
If TextBox4 = "" Then
MsgBox "Erst Kunde eintragen!", vbCritical, "Kunde fehlt!"
Exit Sub
End If
If BereichKunde Is Nothing Then
If TextBox3 = "" Then
MsgBox "Erst Ort eintragen!", vbCritical, "Ort fehlt!"
Exit Sub
End If
wkstab1.Cells(zeiletab1 + 1, 1) = TextBox4.Text
wkstab1.Cells(zeiletab1 + 1, 2) = TextBox3.Text
Else
zeileKunde = BereichKunde.EntireRow.Row
FrageKundeneu = MsgBox("Kunde existiert bereits, Daten werden nur gändert! " , vbExclamation +  _
vbOKCancel, "Kundenstamm")
Select Case FrageKundeneu
Case vbOK
If TextBox3 = "" Then
MsgBox "Erst Straße eintragen!", vbCritical, "Straße fehlt!"
Exit Sub
End If
wkstab1.Cells(zeileKunde, 1) = TextBox4.Text
wkstab1.Cells(zeileKunde, 2) = TextBox3.Text
Case vbCancel
Exit Sub
End Select
End If
End Sub
MfG Christian

Anzeige
danke
06.06.2014 19:32:55
Spenski
deine geringen vba kenntnisse hätte ich gerne :D
leider buggd er in dieser zeile :
Set BereichKunde = wkstab1.Range("A:A").Find(TextBox5, lookat:=xlWhole)
Laufzeitfehler 424
aber trotzdem danke ich versuch mich mal reinzufuchsen
danke

AW: Daten aus anderer Datei in UF ziehen
06.06.2014 19:16:57
Crazy
Hallo Christian
hier mal deine Datei
kannst wahlweise die Listbox klicken zum eintragen oder
direkt den Kunden eintragen
https://www.herber.de/bbs/user/91031.xlsm
MfG Tom

AW: Daten aus anderer Datei in UF ziehen
06.06.2014 19:51:10
Spenski
hallo Tom
das ergebnis ist toll . hab gerade ein breites grinsen im gesicht . frage 2 ist damit ja erledigt.
mein einziges problem ist das die tabelle mit den daten ein anderes tabellenblatt sein soll (wie in der frage beschrieben)
das hat den grund das meherere user (ca 18) eine kopie der eingabemaske bekommen und alles in die selbe datei speichern sollen. die datei ist nur schreibgeschützt , kann also ausgelesen werden um vorhandene kunden zu pflegen
den code zum "Anlegen" habe ich , mit schreibschutz beheben und schleife etc (kann ich auch gern hochladen) damit die user sich nicht gegenseitig blockieren.
will aber auch nicht zuviel umstände machen aber vielleicht ists für einen profi simpel
danke
christian

Anzeige
AW: Daten aus anderer Datei in UF ziehen
06.06.2014 20:54:48
Crazy
Hallo Christian
ich hoffe ich habs richtig verstanden
mit Schreibschutz und so weiter biste bei mir allerdings
an der falschen Adresse ;-)
https://www.herber.de/bbs/user/91032.zip
MfG Tom

AW: Daten aus anderer Datei in UF ziehen
06.06.2014 21:27:41
Spenski
hi
also den schreibschutz nicht beachten, denke das werd ich hinbekommen.
aber leider bekomm ich den code nicht zu laufen den du mir zuletzt geschickt hast. hab alles abgeändert aber bekomme immer laufzeitfehler 9
das mit der Listbox muss auch nicht unbedinkt da das mit der textbox 4 besser funktioniert als ih mir erhofft habe.
jetzt nur noch das ding zum laufen bekommen^^...ich probier mal weiter.
oder passe ich falsch an? habe alle "Ziel" angepasst und deinen zielpfad abgeändert und ' weggenommen
gruss

Anzeige
AW: Daten aus anderer Datei in UF ziehen
06.06.2014 21:35:51
Crazy
Hallo Christian
Laufzeitfehler 9, Index außerhalb des gültigen Bereichs?
dann hast du falsch angepasst...
entweder Tabellenblatt was anders heißt oder die Zieltabelle hat nen andern Pfad
MfG Tom

AW: Daten aus anderer Datei in UF ziehen
06.06.2014 21:46:41
Spenski
habs jetzt so
der pfad der zieldatei ist C:\Users\Spenski\Desktop\MD.xlsx (5x kpntrolliert^^)
Tabelle2 heist das Blatt
Option Explicit
Dim Suchergebnis As Range
Private Sub CommandButton1_Click()
With Workbooks("C:\Users\Spenski\Desktop\MD.xlsx").Worksheets("Tabelle2")
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = TextBox4.Value
.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = TextBox3.Value
End With
End Sub

Private Sub CommandButton2_Click()
With Workbooks("C:\Users\Spenski\Desktop\MD.xlsx").Worksheets("Tabelle2")
Suchergebnis.Offset(0, 1).Value = TextBox3.Value
End With
End Sub

Private Sub CommandButton3_Click()
With Workbooks("C:\Users\Spenski\Desktop\MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
TextBox3.Value = Suchergebnis.Offset(0, 1).Value
Else
TextBox3.Value = ""
End If
End With
End With
End Sub

Private Sub CommandButton4_Click()
Dim strListe As Variant
Workbooks.Open Filename:=ThisWorkbook.Path & "\MD.xlsx"   'wenn sich die Dateien im selben  _
Ordner befinden
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"    'Pfad anpassen
strListe = Workbooks("C:\Users\Spenski\Desktop\MD.xlsx").Worksheets("Tabelle2").Range("A2:A" _
& Cells(Rows.Count, 1).End(xlUp).Row)
ListBox1.List = strListe
End Sub
Private Sub ListBox1_Click()
With ListBox1
TextBox4 = .List(.ListIndex, 0)
End With
End Sub

Private Sub TextBox4_Change()
With Workbooks("C:\Users\Spenski\Desktop\MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
TextBox3.Value = Suchergebnis.Offset(0, 1).Value
Else
TextBox3.Value = ""
End If
End With
End With
End Sub
möchte dir nochmal für deine mühe und den zeitaufwand danken

Anzeige
AW: Daten aus anderer Datei in UF ziehen
06.06.2014 21:55:22
Crazy
Hallo Christian
wo kommt denn der Laufzeitfehler?
das ist nicht nötig:
    Workbooks.Open Filename:=ThisWorkbook.Path & "\MD.xlsx"   'wenn sich die Dateien im selben  _
Ordner befinden
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"    'Pfad anpassen

entweder du nimmst den ersten Satz oder den zweiten
beide sind nicht nötig
und überall wo das steht:
With Workbooks("C:\Users\Spenski\Desktop\MD.xlsx").Worksheets("Tabelle2")

reicht das hier
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
MfG Tom

Anzeige
AW: Daten aus anderer Datei in UF ziehen
06.06.2014 22:32:34
Spenski
so...habs jetzt ein wenig angepasst. soweit läuft es... das einzige was er nicht macht ist den alten kunden zu überschreiben
es kommt dann Laufzeitfehler 424
Option Explicit
Dim Suchergebnis As Range
Private Sub CommandButton1_Click() 'Anlegen
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = TextBox4.Value
.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = TextBox3.Value
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Private Sub CommandButton2_Click() 'Suchen
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
Suchergebnis.Offset(0, 1).Value = TextBox3.Value  ' _
End With
ActiveWorkbook.Close
End Sub
Private Sub CommandButton3_Click() 'Update
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
TextBox3.Value = Suchergebnis.Offset(0, 1).Value
Else
TextBox3.Value = ""
End If
End With
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
gruss

Anzeige
AW: Daten aus anderer Datei in UF ziehen
06.06.2014 22:46:56
Crazy
Hallo Christian
das sollte dann schon so aussehen
Private Sub UserForm_Initialize()
CommandButton2.Enabled = False
End Sub
Private Sub CommandButton2_Click() 'update
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
Suchergebnis.Offset(0, 1).Value = TextBox3.Value
End With
ActiveWorkbook.Close
End Sub
Private Sub CommandButton3_Click() 'suchen
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
TextBox3.Value = Suchergebnis.Offset(0, 1).Value
CommandButton2.Enabled = True
Else
TextBox3.Value = ""
End If
End With
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
allerdings würde ich nicht in jedem Button das Workbooks.Open nehmen
MfG Tom

Anzeige
AW: Daten aus anderer Datei in UF ziehen
06.06.2014 22:57:03
Spenski
wieder laufzeit 424 an anderer stelle beim update (wenn er überschreiben soll)
Option Explicit
Dim Suchergebnis As Range
Private Sub CommandButton1_Click() 'Anlegen
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = TextBox4.Value
.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Value = TextBox3.Value
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Private Sub UserForm_Initialize()
CommandButton2.Enabled = False
End Sub

Private Sub CommandButton2_Click() 'update
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
Suchergebnis.Offset(0, 1).Value = TextBox3.Value '  hier hängt er
End With
ActiveWorkbook.Close
End Sub

Private Sub CommandButton3_Click() 'suchen
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
TextBox3.Value = Suchergebnis.Offset(0, 1).Value
CommandButton2.Enabled = True
Else
TextBox3.Value = ""
End If
End With
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Anzeige
AW: Daten aus anderer Datei in UF ziehen
07.06.2014 07:17:54
Spenski
hallo
gerade aufgewacht , 1min dauf geschaut und fehler sofort entdeckt. ich glaube ich war gestern einfach nicht mehr aufnahmefähig.
Beim "update" gibts ja kein Suchergebnis, wie soll er das dann offset finden.
habs jetzt so.
Private Sub CommandButton2_Click() 'update
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
Suchergebnis.Offset(0, 1).Value = TextBox3.Value
End With
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

heute pass ich die userform nochmal um mehrere TextBoxen an. falls noch probleme auftreten stoss ich das thema nochmal an-
ansonsten dank ich dir für deine hilfe. es hat mir sehr viel geholfen.
gruss und schöne pfingsten
christian

Anzeige
AW: Daten aus anderer Datei in UF ziehen
07.06.2014 07:43:18
Crazy
Hallo Christian
hier nochmal überarbeitet
https://www.herber.de/bbs/user/91034.xlsm
bei mir läuft es jetzt einwandfrei durch
jetzt kann es nur noch am Schreibschutz liegen
MfG Tom

AW: Daten aus anderer Datei in UF ziehen
07.06.2014 10:33:01
Spenski
guten morgen Tom .
habs jetzt so und es klappt wunderbar.
der user hat nur 2 button : suchen und anlegen
suchen:
wenn ich in die textbox(kunde) was eingebe und suchen drücke sucht er obs die daten schon gibt.
anlegen:
wenn ich alle textboxen ausfülle und anlegen sucht durchsucht er erst die datenbank und überschreibt die daten falls es den kunden schon gibt. gibts den kunden nicht wird die nächste freie zeile beschrieben.
schreibschutz war bisher noch gar nicht drin. aber das bekomm ich schon hin.
hier nochmal der ganze code
Option Explicit
Dim Suchergebnis As Range
Private Sub CommandButton2_Click() 'anlegen
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
Suchergebnis.Offset(0, 1).Value = TextBox3.Value
End If
End With
End With
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
If Suchergebnis Is Nothing Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox4.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = TextBox3.Text
End If
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Private Sub CommandButton3_Click() 'suchen
Workbooks.Open Filename:="C:\Users\Spenski\Desktop\MD.xlsx"
With Workbooks("MD.xlsx").Worksheets("Tabelle2")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox4, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
TextBox3.Value = Suchergebnis.Offset(0, 1).Value
Else
TextBox3.Value = ""
End If
End With
End With
ActiveWorkbook.Close
End Sub

und danke für deine tolle hilfe
christian

AW: Daten aus anderer Datei in UF ziehen
07.06.2014 17:53:39
Crazy
Hallo Christian
dein Ergebnis der fertigen Mappe übertrifft meine Erwartungen
wenn ich das richtig sehe, können deine 18 Kollegen also nur neu anlegen
und ohne Kontrolle einen Datensatz zerschießen... so hab ich es ein paar mal gemacht
ich hatte einfach in die Eingabemaske "123456" eingetragen und als nächstes einfach den ersten Button geklickt und schon war die Datenreihe hin.
Das suchen eines Eintrags mit klick auf das Label machst also nur du?
oder dürfen deine Kollegen das als Suchspiel ansehen? ;-)
ansonsten... Respekt ;-)
MfG Tom

AW: Daten aus anderer Datei in UF ziehen
07.06.2014 23:32:21
Spenski
hi tom.
ich weiss das sieht sehr umständlich und "billig" aus aber mein problem , bzw unsers ist , das wir eine komplettlösung für ein workshop projekt entferfen müssen und auch damit arbeiten.
das ist jetzt auch erst der anfang , das schwere kommt noch^^ ....das lager soll im endeffekt die aufträge selber planen mit X opt losgrössen etc^^ ... das hier sind nur hilfsdaten
wenn das ergebnis gut ist wird erst ein richtiges programm von der IT im SAP geschrieben.
zitat: ich hatte einfach in die Eingabemaske "123456" eingetragen und als nächstes einfach den ersten Button geklickt und schon war die Datenreihe hin.
das hat mich jetzt gerade zum nachdenken gebracht. ja das ist eine schwachstelle , die ich noch über msg boxen minimieren will.
was ja nicht passieren kann ist das eine materialnummer ganz aus der datenbank verschwindet, höchstens die daten dazu.
bin gerade dabei eine anzeige zu bauen die die datenbank ausliest und auf zb fehlende daten hinweist, klappt auch ganz gut.
gruss

337 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige