with mit Objektvariablen

Windows("Daten.xls").Activate Sheets("Werte").Select With Sheets("Werte").Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) Set c = .Find(Geraetenummer, LookIn:=xlValues) If Not c Is Nothing Then c.Select ActiveCell.Select ActiveCell = Geraetenummer GoTo weiter End If Geraetenummer = GeraeteMax Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select 'letzte leere zelle ActiveCell.Select ActiveCell = Geraetenummer Selection.Offset(0, 0) = Geraetenummer GoTo weiter End With

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dim wbDaten As Workbook Dim wksWerte As Worksheet On Error Resume Next Set wbDaten = Workbooks("Daten.xls") On Error GoTo 0 If wbDaten Is Nothing Then _ Set wbDaten = Workbooks.Open(Filename:="C:/Eigene Dateien/Daten.xls") Set wksWerte = wshDaten.Worksheets("Werte") With wksWerte Set c = .Range("A1:A" & Cells(Rows.Count, 1).End(xlUp)).Find(Geraetenummer, LookIn:= _ xlValues) If Not c Is Nothing Then c = Geraetenummer Else .Cells(Rows.Count, 1).End(xlUp) = GeraeteMax End If End With

Sub t() Dim wbDaten As Workbook Dim wksWerte As Worksheet Dim c As Range 'On Error Resume Next 'Set wbDaten = Workbooks("Daten.xls") 'On Error GoTo 0 'If wbDaten Is Nothing Then _ 'Set wbDaten = Workbooks.Open(Filename:="C:/Eigene Dateien/Daten.xls") ' ******* Dummy Testdaten erzeugen ******* Dim Geraetenummer As Long, GeraeteMax As Long Geraetenummer = 8 GeraeteMax = 5 Set wbDaten = ThisWorkbook Set wksWerte = wbDaten.Worksheets("Werte") With wksWerte If WorksheetFunction.CountIf(.Columns(1), Geraetenummer) = 0 Then _ .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = GeraeteMax End With End Sub

Sub Geraet_speichern() Dim GeraeteNummer As String Dim GeraeteArt As String Dim Marke As String Dim Model As String Dim wksWerte As Worksheet Dim GeraetMax As Long, c As Range GeraeteNummer = Range("Geraetenummer") GeraeteArt = Range("GeraeteArt") Marke = Range("Marke") Model = Range("Model") On Error Resume Next Set wksWerte = Workbooks("Werte.xls").Worksheets("geraete") On Error GoTo 0 If wksWerte Is Nothing Then MsgBox "Die Datei ""Werte.xls"" ist nicht geöffnet oder es fehlt das Blatt ""geraete""." Exit Sub End If With wksWerte GeraetMax = Application.WorksheetFunction.Max(.Range("A:A")) + 1 Set c = .Range("A:A").Find(what:=GeraeteNummer, LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then Select Case MsgBox("Die angegebene Gerätenummer konnte nicht gefunden werden:" & vbLf & _ "- JA: Gerät mit der angegebenen Nummer neu anlegen (" & GeraeteNummer & ")" & vbLf & _ "- NEIN: Gerät mit der nächsten Nummer neu anlegen (" & GeraetMax & ")" & vbLf & _ "- ABBRECHEN: Eingabe verwerfen", vbQuestion + vbYesNoCancel) Case vbCancel Exit Sub Case vbNo GeraeteNummer = GeraetMax Case vbYes End Select Set c = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) End If If GeraeteNummer = "" Then GeraeteNummer = GeraetMax c.Resize(1, 4).Value = Array(GeraeteNummer, GeraeteArt, Marke, Model) End With wksWerte.Parent.Save End Sub

WOW Daniel Danke .. Perfekt.
Eine Frage habe ich. In der Testdatei habe weitere Werte weggelassen damit nur das Wesentliche drinnen ist. Nun ist in einem Feld ein Datum. Wenn Range"Garantie" leer ist wird in die Tabelle 00:00:00 eingetragen. Was muss ich ändern wenn der Werte leer ist auch ein leeres Feld in die Tabelle Werte.xls geschrieben wird?
Und ich möchte dass am Ende der Methode die Datei Werte.xls ausgeblendet wird.
Ich mache dies mit "Windows("Geraete.xls").Visible = False" geht das auch mit wksWerte?
Hier der angepasse Quellcode

Sub Geraet_speichern()
Dim GeraeteNummer As String
Dim GeraeteArt As String
Dim Marke As String
Dim Model As String
Dim GeraeteTyp As String
Dim GeraeteNr As LongLong
Dim Garantie As Date
Dim wksWerte As Worksheet
Dim GeraetMax As Long, c As Range
GeraeteNummer = Range("Geraetenummer")
GeraeteArt = Range("GeraeteArt")
Marke = Range("Marke")
Model = Range("Model")
GeraeteTyp = Range("GeraeteTyp")
GeraeteNr = Range("GeraeteNr")
Garantie = Range("GeraeteGarantie")
On Error Resume Next
Set wksWerte = Workbooks("Werte.xls").Worksheets("geraete")
On Error GoTo 0
If wksWerte Is Nothing Then
MsgBox "Die Datei ""Werte.xls"" ist nicht geöffnet oder es fehlt das Blatt ""geraete""."
Exit Sub
End If
With wksWerte
GeraetMax = Application.WorksheetFunction.Max(.Range("A:A")) + 1
Set c = .Range("A:A").Find(what:=GeraeteNummer, LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
Select Case MsgBox("Die angegebene Gerätenummer konnte nicht gefunden werden:" & vbLf & _
"- JA: Gerät mit der angegebenen Nummer neu anlegen (" & GeraeteNummer & ")" & vbLf & _
"- NEIN: Gerät mit der nächsten Nummer neu anlegen (" & GeraetMax & ")" & vbLf & _
"- ABBRECHEN: Eingabe verwerfen", vbQuestion + vbYesNoCancel)
Case vbCancel
Exit Sub
Case vbNo
GeraeteNummer = GeraetMax
Case vbYes
End Select
Set c = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
If GeraeteNummer = "" Then GeraeteNummer = GeraetMax
c.Resize(1, 7).Value = Array(GeraeteNummer, GeraeteArt, Marke, Model, GeraeteTyp, GeraeteNr,  _
Garantie)
End With
Windows("Werte.xls").Visible = False

Liebe Grüße Sabbel

Hi
wenn du ein leeres Feld in eine Zahlenvariable (und dazu gehört auch eine Variable mit dem Format Date) einliest, bekommt diese Variable den Wert 0.
Beim Rückschreiben müsste man dann eine IF-Abfrage machen, dh wenn Garantie = 0, dann lasse die Zelle leer, ansonsten schreibe ihren Wert in die Zelle.
Da du die Werte nicht einzeln, sondern mit einem Array alle gleichzeitig in Zellen zurückschreibst, musst du das IF ins Array einbauen, das geht über IIF
c.Resize(1, 7).Value = Array(GeraeteNummer, GeraeteArt, Marke, Model, GeraeteTyp, GeraeteNr, IIF(Garantie = 0, "", Garantie))
zur zweiten Frage:
ausblenden musst du wie bisher das Window (mit Windows(Dateiname).visible = false)
das Workbook selbst kann man nicht ausblenden (liegt auch daran, dass jedes Workbook auch mehrere Windows haben kann)
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread