Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1368to1372
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
Inhaltsverzeichnis

Problem mit Code

Problem mit Code
10.07.2014 00:14:10
Spenski
Hallo habe ein kleines Problem mit einem code, eine Beispieldatei ist schwer hochzuladen wegen den ganzen pfaden. das möchte ich keinem aufhalsen :D
mein problem markiere ich FETT und beschreibe das problem unter dem code:
Private Sub CommandButton1_Click() 'anlegen
TextBox1.Tag = "Jetztnicht"
TextBox2.Tag = "Jetztnicht"
TextBox3.Tag = "Jetztnicht"
TextBox4.Tag = "Jetztnicht"
TextBox5.Tag = "Jetztnicht"
TextBox6.Tag = "Jetztnicht"
TextBox11.Tag = "Jetztnicht"
Dim sPath$, nReturn%, iTimer%
Const ObenKennwort$ = "1234"
Const SchreibLeseKennwort$ = "1234"
iTimer = 10
sPath = "C:\GAEdaten.xlsx"
nReturn = TestOpen(sPath)
Do While nReturn  0
If nReturn = 2 Then
Exit Do
End If
If iTimer = 0 Then Exit Do
Application.Wait Now + TimeSerial(0, 0, 1)
DoEvents
iTimer = iTimer - 1
nReturn = TestOpen(sPath)
Loop
If nReturn = 0 Then
Application.DisplayAlerts = False
With Workbooks.Open(sPath, ReadOnly:=False, Password:=ObenKennwort, WriteResPassword:= _
SchreibLeseKennwort, IgnoreReadOnlyRecommended:=True)
If .ReadOnly = False Then
With .Sheets("Datenbank")
  With Workbooks("GAEdaten.xlsx").Worksheets("Datenbank")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox1, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
Dim Eingabewert As Byte
Eingabewert = MsgBox("Ist die Schnittliste Schichtübergreifend, dann bitte mit JA antworten!" &  _
_
vbCrLf & "" & vbCrLf & "Soll die Schnittliste überschrieben werden, dann bitte mit NEIN  _
antworten", vbYesNoCancel, "Schnittlistennummer existiert bereits!")
If Eingabewert = vbYes Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = ComboBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2) = ComboBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 3) = Now()
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 4) = TextBox6.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 5) = TextBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 6) = TextBox5.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 7) = TextBox3.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 8) = TextBox4.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 9) = TextBox11.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 10) = TextBox7.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 11) = TextBox8.Text
ElseIf Eingabewert = vbNo Then
Suchergebnis.Offset(0, 1).Value = ComboBox1.Value
Suchergebnis.Offset(0, 2).Value = ComboBox2.Value
Suchergebnis.Offset(0, 4).Value = TextBox6.Value
Suchergebnis.Offset(0, 5).Value = TextBox2.Value
Suchergebnis.Offset(0, 6).Value = TextBox5.Value
Suchergebnis.Offset(0, 7).Value = TextBox3.Value
Suchergebnis.Offset(0, 8).Value = TextBox4.Value
Suchergebnis.Offset(0, 9).Value = TextBox11.Value
Suchergebnis.Offset(0, 10).Value = TextBox7.Value
Suchergebnis.Offset(0, 11).Value = TextBox8.Value
Else
Workbooks("GAEdaten.xlsx").Close SaveChanges:=False
Exit Sub
End If
End If
End With
End With
With Workbooks("GAEdaten.xlsx").Worksheets("Datenbank")
If Suchergebnis Is Nothing Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = ComboBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2) = ComboBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 3) = Now()
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 4) = TextBox6.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 5) = TextBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 6) = TextBox5.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 7) = TextBox3.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 8) = TextBox4.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 9) = TextBox11.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 10) = TextBox7.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 11) = TextBox8.Text
End If
End With
End With
.Close True
Else
.Close False
MsgBox "Die Datei ist Schreibgeschützt, versuchen sie es noch einmal!" 'text ä _
ndern?
End If
End With
Application.DisplayAlerts = True
ElseIf nReturn = 2 Then
MsgBox "Zieldatei nicht gefunden. Bitte Info an KPM Coach!" 'text ändern?
ElseIf nReturn = 1 Then
MsgBox "Die Datei ist Schreibgeschützt, versuchen sie es noch einmal!" 'text ändern?
Exit Sub
End If
Dim objControl As Control
For Each objControl In Controls
Select Case TypeName(objControl)
Case "TextBox"
objControl.Text = ""
Case "CheckBox"
objControl.Value = False
Case "OptionButton"
objControl.Value = False
End Select
Next
TextBox1.Tag = ""
TextBox2.Tag = ""
TextBox3.Tag = ""
TextBox4.Tag = ""
TextBox5.Tag = ""
TextBox6.Tag = ""
TextBox11.Tag = ""
End Sub

der code sucht in einer datenbank in spalte A nach dem inhalt von textbox1 meiner userform.
findet er den inhalt öffnet sich eine JA NEIN ABBRECHEN msgbox.
klicke ich auf Nein über schreibt er die komplette zeile in dem das suchergebnis auftaucht. das klappt wunderbar.
abbrechen funktioniert auch wie es soll.
klicke ich aber auf JA soll er die Nächste freie Zeile suchen und den inhalt dort einfügen. das funktioniert nicht. es werden die zu übertragenden daten in Zeile1 eingefügt.
ich denke mal das es mit dem suchergebnis zu tun hat und er deshalb durcheinander kommt.
gibt es sowas wie den befehl Suchergebnis=Nothing wenn ich in der msgbox auf ja klicke?
danke fürs lesen
gruss

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem mit Code
10.07.2014 09:43:43
Rudi
Hallo,
hier ist imho das fette With überflüssig. Ist doch schon vorher da.
     With Workbooks.Open(sPath, ReadOnly:=False, Password:=ObenKennwort, WriteResPassword:= _
SchreibLeseKennwort, IgnoreReadOnlyRecommended:=True)
If .ReadOnly = False Then
With .Sheets("Datenbank")
With Workbooks("GAEdaten.xlsx").Worksheets("Datenbank")
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox1, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
Variablendeklarationen immer am Anfang des Codes, nicht mittendrin.
Eingabewert würde ich per Select Case auswerten, nicht If ElseIf
Setz dir bei der MsgBox einen Haltepunkt und geh den Code weiter mit F8 durch.
Gruß
Rudi

Anzeige
AW: Problem mit Code
10.07.2014 11:15:11
EtoPHG
Hallo Spenski,
Verschiedene Pfade möchtest du uns nicht aufhalsen, aber so einen schlecht strukturierten Code :-(
Die Referenzierung von
 .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Text
...
auf das übergeordnete (aktive) With-Objekt
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
kann IMHO überhaupt nicht klappen. In diesem fehlt übrigends auch eine Referenzierung des Row.Count, welcher u.U. zu einem schwerwiegenden Fehler führen kann.
Gruess Hansueli

Anzeige
@ Hansueli
10.07.2014 11:50:44
Spenski
Hallo Hansueli
mit dem pfaden zumuten habe ich nur geschrieben weil mindestens 40 pfade abgeändert werden müssten. der gepostete code ist nichtmal 5% der ganzen mappe.
zu der qualität der codes kann ich einfach nur zustimmen... ich bin purer anfänger und werde es auch immer bleiben und das streite ich auch nicht ab.

sorry, Rudi.sollte AW sollte 1 Stufe höher (owT)
10.07.2014 11:17:09
EtoPHG

AW: Problem mit Code
10.07.2014 12:04:17
Spenski
Hallo Rudi , danke für deinen Post.
das von dir fett markierte habe ich entfernt, danke schonmal dafür.
Mit dem haltepunkt setzen habe ich auch gemacht , auch danke dafür , diese funktion kannte ich noch nicht und werde sie jetzt bestimmt viel öfter nutzen.
allerdings kommt bei meinem aussschnitt ja kein fehler vor, sondern werden die daten nur nicht in die richtige zeile kopiert wenn ich in der msgbox JA drücke. fehlermeldungen treten keine auf.
wenn er ein suchergebniss findet und ich bei der msgbox JA sage soll er das selbe machen als wenn er kein suchergebniss gefunden hätte
wenn er kein suchergebniss findet fügt er die inhalte auch immer in die erste freie zeile, da funktionierts
    With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox1, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
Dim Eingabewert As Byte
Eingabewert = MsgBox("Ist die Schnittliste Schichtübergreifend, dann bitte mit JA antworten!" &  _
vbCrLf & "" & vbCrLf & "Soll die Schnittliste überschrieben werden, dann bitte mit NEIN antworten", vbYesNoCancel, "Schnittlistennummer existiert bereits!")
If Eingabewert = vbYes Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = ComboBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2) = ComboBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 3) = Now()
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 4) = TextBox6.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 5) = TextBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 6) = TextBox5.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 7) = TextBox3.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 8) = TextBox4.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 9) = TextBox11.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 10) = TextBox7.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 11) = TextBox8.Text
ElseIf Eingabewert = vbNo Then
Suchergebnis.Offset(0, 1).Value = ComboBox1.Value
Suchergebnis.Offset(0, 2).Value = ComboBox2.Value
Suchergebnis.Offset(0, 4).Value = TextBox6.Value
Suchergebnis.Offset(0, 5).Value = TextBox2.Value
Suchergebnis.Offset(0, 6).Value = TextBox5.Value
Suchergebnis.Offset(0, 7).Value = TextBox3.Value
Suchergebnis.Offset(0, 8).Value = TextBox4.Value
Suchergebnis.Offset(0, 9).Value = TextBox11.Value
Suchergebnis.Offset(0, 10).Value = TextBox7.Value
Suchergebnis.Offset(0, 11).Value = TextBox8.Value
Else
Workbooks("GAEdaten.xlsx").Close SaveChanges:=False
Exit Sub
End If
End If
End With
If Suchergebnis Is Nothing Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = ComboBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2) = ComboBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 3) = Now()
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 4) = TextBox6.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 5) = TextBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 6) = TextBox5.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 7) = TextBox3.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 8) = TextBox4.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 9) = TextBox11.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 10) = TextBox7.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 11) = TextBox8.Text
End If

gruss und danke fürs lesen
christian

Anzeige
AW: Problem mit Code
10.07.2014 12:20:32
EtoPHG
Hallo Christian,
Ich hab doch weiter oben erwähnt, was die Ursache des Fehlers ist:
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
If Eingabewert = vbYes Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Text

Die letzte Code-Zeile referenziert nur auf den vorherigen With-Bereich und nicht, wie du vermutlich beabsichtigst, auf das ganze Tabellenblatt!
Gruess Hansueli

AW: Problem mit Code
10.07.2014 12:26:58
Spenski
hab ich gelesen und darüber habe ich mir dann auch gedanken gemacht.
ich habe es jetzt so umgeschrieben und es funktioniert. ich danke euch beiden für eure hilfe
With .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
Set Suchergebnis = .Find(TextBox1, LookIn:=xlValues, lookat:=xlWhole)
If Not Suchergebnis Is Nothing Then
Dim Eingabewert As Byte
Eingabewert = MsgBox("Ist die Schnittliste Schichtübergreifend, dann bitte mit JA antworten!" &  _
vbCrLf & "" & vbCrLf & "Soll die Schnittliste überschrieben werden, dann bitte mit NEIN antworten", vbYesNoCancel, "Schnittlistennummer existiert bereits!")
If Eingabewert = vbYes Then
Set Suchergebnis = Nothing
ElseIf Eingabewert = vbNo Then
Suchergebnis.Offset(0, 1).Value = ComboBox1.Value
Suchergebnis.Offset(0, 2).Value = ComboBox2.Value
Suchergebnis.Offset(0, 4).Value = TextBox6.Value
Suchergebnis.Offset(0, 5).Value = TextBox2.Value
Suchergebnis.Offset(0, 6).Value = TextBox5.Value
Suchergebnis.Offset(0, 7).Value = TextBox3.Value
Suchergebnis.Offset(0, 8).Value = TextBox4.Value
Suchergebnis.Offset(0, 9).Value = TextBox11.Value
Suchergebnis.Offset(0, 10).Value = TextBox7.Value
Suchergebnis.Offset(0, 11).Value = TextBox8.Value
Else
Workbooks("GAEdaten.xlsx").Close SaveChanges:=False
Exit Sub
End If
End If
End With
If Suchergebnis Is Nothing Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = TextBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1) = ComboBox1.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2) = ComboBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 3) = Now()
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 4) = TextBox6.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 5) = TextBox2.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 6) = TextBox5.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 7) = TextBox3.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 8) = TextBox4.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 9) = TextBox11.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 10) = TextBox7.Text
.Cells(.Rows.Count, 1).End(xlUp).Offset(0, 11) = TextBox8.Text
End If
gruss
christian
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige