Daten ab einen Freien Bereich eintragen

Croix-aigle

Mitglied
Ich möchte die Daten ab Zelle A17 eintragen lassen. A17 ist immer Belegt.
z.B.
ZeileEinfügen.PNG

Der Code ist Aktuell wie folgt, fügt aber die Werte erst ab "A45" ein, da diese von unten nach oben ganz leer sind.

Visual Basic:
Dim intFreienBereich As Long
    With Worksheets("Rechnung")
    intFreienBereich = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(intFreienBereich, 2).Value = Me.txtEinsatz.Value
        .Cells(intFreienBereich, 3) = Me.txtMenge.Value
        .Cells(intFreienBereich, 4) = CCur(Me.txtKosten.Value)
    End With
End Sub

Der Code ".Cells(Rows.Count, 1).End(xlUp).Row + 1" müsste für die Suche ab A17 angepasst werden.

Ziel ist es:
Wie im Bild ist A18 belegt.
1. Neuer Eintrag
Möglichkeit A) soll in "A19" die 3 Eintragen ("A18" +1) und dies für jede weitere Zeile, die eingetragen wird.
Möglichkeit B) A18 +1 über SVERWEIS, wenn B19 Name steht

2. somit Soll der nächste Wert in (B19 "txtEinsatz"), (C19"txtMenge"), (D19"txtKosten") eingetragen werden.
 

Anhänge

  • ZeileEinfügen.PNG
    ZeileEinfügen.PNG
    16,5 KB · Aufrufe: 5
Zuletzt bearbeitet von einem Moderator:
Visual Basic:
'/**
' * Ermittelt die letzte gefüllte Zeile eines Worksheets
' * @param  Worksheet   Das Worksheetobjekt, das durchsucht werden soll
' * @return Long        Die Zeilennummer. Wenn das ganze Sheet leer ist, ist der Rückgabewert 0
' */
Public Function xlsGetLastRow(ByRef sheet As Object) As Long
    Const xlCellTypeLastCell = 11

    'Zur letzten initialisierten Zeile gehen
    xlsGetLastRow = sheet.cells.SpecialCells(xlCellTypeLastCell).row
   
    'Von dort zurücksuchen bis zur Letzten zeile mit Inhalt
    Do While sheet.Application.WorksheetFunction.CountA(sheet.rows(xlsGetLastRow)) = 0 And xlsGetLastRow > 1
        xlsGetLastRow = xlsGetLastRow - 1
    Loop
End Function

Die Anwendung für dich:
Visual Basic:
Dim intFreienBereich As Long
    intFreienBereich = xlsGetLastRow(Worksheets("Rechnung")) + 1
    With Worksheets("Rechnung")
        .Cells(intFreienBereich, 2).Value = Me.txtEinsatz.Value
        .Cells(intFreienBereich, 3) = Me.txtMenge.Value
        .Cells(intFreienBereich, 4) = CCur(Me.txtKosten.Value)
    End With
End Sub
 
Das ganze Läuft sauber ab, nur fügt er die Zeilen alle in Zeile 38 ab ein, nach Gesamtsumme.

Wenn es so nicht geht, wie wäre es mit einem Butten /Kombinationsfeld, der nach einer bestimmten Vorgabe in die Zeile eingibt, z.B. Zeile 19, neuer Eintrag auf 20 ändern und der eintrag erfolgt in Zeile 20. Der Aufwand wäre größer und die Zeilen wären dadruch fest definiert.
 

Anhänge

  • Userform.PNG
    Userform.PNG
    5,2 KB · Aufrufe: 2
Zuletzt bearbeitet:
so, die momentane Notlösung:
With Worksheets("Rechnung")
If CbBoxZeile = 18 Then
Range("A18") = 2
Range("B18") = Me.txtEinsatz.Value
Range("C18") = Me.txtMenge.Value
Range("D18") = CCur(Me.txtKosten.Value)
End If
If CbBoxZeile = 19 Then
Range("A19") = 3
Range("B19") = Me.txtEinsatz.Value
Range("C19") = Me.txtMenge.Value
Range("D19") = CCur(Me.txtKosten.Value)
End If
If CbBoxZeile = 20 Then
Range("A20") = 4
Range("B20") = Me.txtEinsatz.Value
Range("C20") = Me.txtMenge.Value
Range("D20") = CCur(Me.txtKosten.Value)
End If
If CbBoxZeile = 21 Then
Range("A21") = 5
Range("B21") = Me.txtEinsatz.Value
Range("C21") = Me.txtMenge.Value
Range("D21") = CCur(Me.txtKosten.Value)
End If
If CbBoxZeile = 22 Then
Range("A22") = 6
Range("B22") = Me.txtEinsatz.Value
Range("C22") = Me.txtMenge.Value
Range("D22") = CCur(Me.txtKosten.Value)
End If
If CbBoxZeile = 23 Then
Range("A23") = 7
Range("B23") = Me.txtEinsatz.Value
Range("C23") = Me.txtMenge.Value
Range("D23") = CCur(Me.txtKosten.Value)
End If
End With

End Sub
 
Haben denn die Zeilen 19 bis 37 irgendwo Daten drin? Ich dachte, da sind nur noch leere Zeilen.
Wenn du nur die Spalte A prüfen willst, könnte das so gehen
Visual Basic:
Do While sheet.Application.WorksheetFunction.CountA(sheet.Cells(xlsGetLastRow, 1)) = 0 And xlsGetLastRow > 1
Also in der Funktion bei der Schleife nicht die ganze Zeile Prüfen sondern nur das Feld in Spalte A (Spalte 1)
 
habs geändert, funktioniert nur, wenn unten die Adresse (A38) usw nicht in Spalte A stehen.

Das einzigste was die leeren Felder behinhalten sind:
'Bereich Zentrieren
Worksheets("Rechnung").Range("A18:A36").HorizontalAlignment = xlCenter

'Bereich als Währung deklarieren
Worksheets("Rechnung").Range("D18:D36").NumberFormat = "#,##0.00 €"

Spalte E Formel = C* x D*


Auf das was ich vermutlich hinaus will, ist Logisches Denken, wie ein Mensch.

Kann man Zu: Do While sheet.Application.WorksheetFunction.CountA19:A36 wäre sowas machbar?
Suche nur in A19:A36 nach freie Zeile
 
Jepp
Visual Basic:
'/**
' * Ermittelt die erste leere Zeile eines Ranges
' * @param  Worksheet   Das Worksheetobjekt, das durchsucht werden soll
' * @param	String		Addresse, die durchsucht werden soll. zB "A19:A36"
' * @return Long        Die Zeilennummer. Wenn das ganze Sheet leer ist, ist der Rückgabewert 0
' */
Public Function getFirstEmptyRow(ByRef sheet As WorkSheet, ByVal strRange As String) As Long
    Dim rngTarget As Range
    Dim i As Integer
    Set rngTarget = sheet.Range(strRange)

    'Von Anfang an durchgehen bis zum ersten leeren
    For i = 1 to rngTarget.rows.count
    	If WorksheetFunction.CountA(rngTarget.rows(i)) = 0 Then 
    		getFirstEmptyRow = rngTarget.Row + (i - 1)
    		Exit For
        End If
    Loop
End Function
Visual Basic:
 intFreienBereich = getFirstEmptyRow(Worksheets("Rechnung"), "A19:A36")
 
Schön. Eine gelb markierte Zeile.
Gibt es da auch noch eine Fehlermeldung dazu oder soll ich einfach mal ein wenig herumraten?

BITTE! IMMER FEHLERMELDUNGEN UND/ODER FEHLVERHALTEN MITGEBEN!
 

Neue Beiträge

Zurück