Office: Erste freie Zeile in Tabelle suchen und einfügen

Hallo Leute,

Ich habe mir einen Code zusammengebastelt der Werte in eine anderes Blatt einfügen soll.

Doch in diesem Blatt in dem es eingefügt wird ist der Bereich als Tabelle formatiert.
Dies scheint zu einem Fehler zu führen den er fügt es nicht in die Tabelle ein sondern eins weiter unten.

Mein Code:

Code:

Private Sub CommandButton21_Click()

Dim erste_freie_Zeile As Integer
erste_freie_Zeile = Sheets("kasse").Range("A65536").End(xlUp).Offset(1, 0).Row

    Sheets("kasse").Cells(erste_freie_Zeile, 1) = ActiveSheet.Range("S42").Value 'Datum
    Sheets("kasse").Cells(erste_freie_Zeile, 2) = ActiveSheet.Range("T42").Value 'Art
    Sheets("kasse").Cells(erste_freie_Zeile, 3) = ActiveSheet.Range("U42").Value 'Betrag
End Sub

muss ich da was hinzufügen oder sollte ich die Tabelle selber ansprechen?
Doch wie spricht man eine Tabelle an?

Danke Gruß Rene

 

Hallo René,

wenn du im Arbeitsblatt "kasse" den Bereich, an den du Daten aus ActiveSheet anfügen willst, als "Tabelle" definiert hast, gibt es nur dann Probleme, wenn du eine Ergebniszeile als letzte Zeile der Tabelle anzeigen lässt.

Mein Makro unten ist nur eine Erweiterung deines Makros.
1) Es geht davon aus, dass die Tabelle im Arbeitsblatt "kasse" "Tab1_Kasse" heißt
2) Es merkt sich die Anzeigeeinstellung der Ergebniszeile in der Variablen "Ist_Totals_On" und blendet dann die Ergebniszeile aus.
3) Dann wird dein Makro ausgeführt.
4) Am Ende des Makros wird der Anzeigestatus für die Ergebniszeile wieder hergestellt.

Du müsstest also, bevor du mein Makro verwendest, die beiden blau gekennzeichneten Namen durch den Namen deiner Tabelle im Arb.Blatt "kasse" ersetzen.
Diesen Namen erhältst du, wenn du die aktive Zelle in diesen Tabellenbereich stellst und im Menüband > Kontext-Tabulator "TABELLENTOOLS/ENTWURF" > Gruppe "Eigenschaften" > TextBox "Tabellenname:" nachschaust.

Code:

Private Sub CommandButton21_Click()

  Dim erste_freie_Zeile As Integer
  Dim Ist_Totals_On As Boolean

  With Sheets("kasse")
  
    With .ListObjects([COLOR="#0000CD"]"Tab1_Kasse"[/COLOR])
      Ist_Totals_On = .ShowTotals
      .ShowTotals = False
    End With
    erste_freie_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row

    .Cells(erste_freie_Zeile, 1) = ActiveSheet.Range("S42").Value 'Datum
    .Cells(erste_freie_Zeile, 2) = ActiveSheet.Range("T42").Value 'Art
    .Cells(erste_freie_Zeile, 3) = ActiveSheet.Range("U42").Value 'Betrag
    
    .ListObjects([COLOR="#0000CD"]"Tab1_Kasse"[/COLOR]).ShowTotals = Ist_Totals_On
    
  End With
End Sub

 

Hallo Anton,

vielen Dank, funktioniert bestens.

Echt Klasse :-)

Gruß Rene

 

Hallo Rene,

wie ich erst leider heute bemerkte, geht dein Problem auch weit einfacher zu programmieren:
Der blau gekennzeichnete Bezeichner ist jedoch wiederum an deine Verhältnisse anzupassen, wie in meinem letzten Posting beschrieben:

Code:

Private Sub CommandButton21_Click()
  
  With Sheets("kasse")
  
    With .ListObjects("[COLOR="#0000CD"]Tab1_Kasse[/COLOR]").ListRows.Add().Range
      .Cells(1) = ActiveSheet.Range("S42").Value  'Datum
      .Cells(2) = ActiveSheet.Range("T42").Value  'Art
      .Cells(3) = ActiveSheet.Range("U42").Value  'Betrag
    End With
    
  End With
End Sub

In dieser Gestalt ist es egal, ob bei der Tabelle "Tab1_Kasse" im Blatt "kasse" eine Ergebniszeile angezeigt wird oder nicht.

 

Ja es funktioniert auch so, Vielen Dank :-)

Einen Guten Rutsch ins neue Jahr
Gruß Rene

 

Hallo Anton,

Ein gutes neues Jahr wünsch ich dir.

Ich habe bzgl. diesem Code ein Problem.
Was muss ich machen wenn ich dies zusätzlich auch mit Enter bestätigen möchte?

Meine Versuche:

Nach Verlassen der Zelle U42 Code ausführen.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

 If Target.Address = "$U$42" Then
If ActiveSheet.Range("T42") <> "" Then
    ActiveSheet.Range("T42") = UCase(Left(ActiveSheet.Range("T42"), 1)) & Right(ActiveSheet.Range("T42"), Len(ActiveSheet.Range("T42")) - 1)
End If

With Sheets("Haushaltskasse")
    With .ListObjects("Tab1Kasse").ListRows.Add().Range
      .Cells(1) = ActiveSheet.Range("S42").Value  'Datum
      .Cells(2) = ActiveSheet.Range("T42").Value  'Art
      .Cells(3) = ActiveSheet.Range("U42").Value  'Betrag
    End With
End With
ActiveSheet.Range("S42").Value = ""
ActiveSheet.Range("S42").Activate
ActiveSheet.Range("T42").Value = ""
ActiveSheet.Range("U42").Value = ""
End If
End Sub

Hab den Code vom Button kopiert und nach der Überprüfung eingefügt.
doch es gibt immer Komplikationen.
Einmal verstellen sich die Tastenkürzel " Strg+. " zeigt nicht mehr 1.1.2015 sondern 1\1\2015.
Und nach erneutem Versuch kann keine Zelle mehr ausgewählt werden. Echt wirrrr*

Nach weiteren Versuchen wollt ich den Button beim Verlassen der Zelle ansprechen
doch das ist anscheinend nicht möglich, nur bei Makros.
Hab es mit Commandbutton21.Run versucht - negativ
Also wollt ich ihn zumindest aktivieren "auswählen" damit ich beim Verlassen mit Enter der Zelle U42 nur nochmal auf Enter klicken muss um den Button zu Starten doch dies bewirkt leider auch nichts.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$U$42" Then CommandButton21.Activate
End Sub

Ich bin Ratlos was geht hier schief?

Danke Gruß
Rene

 

Hallo,

des Rätsels Lösung liegt in den 2 rot gekennzeichneten Codezeilen.

Die Erklärung:
1) Du hast mit der SUB "Worksheet_Change(...)" die Behandlungs-Routine für das Change-Event des aktiven Arbeitsblattes angezapft. Dieses Change-Ereignis wird bei jeder Datenänderung durch Tasteneingabe etc. ausgelöst. Du hast ganz richtig mit Hilfe von "IF Target.Address="$U$42"... END IF" die Reaktion dieser SUB auf die Zelle U42 beschränkt, aber leider werden auch dann noch eine Reihe von Change-Events ausgelöst - und das Fatale dabei ist, dass jedes Change-Ereignis wieder ein Change-Ereignis auslöst - es entsteht so ein "circulus vitiosus" - das geht solange, bis dem System irgendwo die Ressourcen ausgehen und dann kommt es zu einer Fehlermeldung oder einem Absturz oder zu einer Systemverklemmung.

2) Damit es zu diesem Desaster erst gar nicht kommt, muss man als erste Maßnahme beim Change-Ereignis die Ereignisbehandlung auf Anwendungsebene abschalten (Application.EnableEvents=False)

3) Damit ist man fürs Erste auf der sicheren Seite. Allerdings tut sich dann ein neues Problem auf: Man muss am Ende des IF-Blockes die Ereignisbehandlung wieder sicher einschalten (Application.EnableEvents=True). Passiert das aus irgendeinem Grund nicht (zB. weil durch einen Error die Sub vorzeitig verlassen wurde), ist die Ereignisbehandlung tot. Man muss sie dann händisch im "Direktbereich"-Fenster mit vorgenanntem Befehl wieder einschalten.
Ist man sich nicht sicher, ob ein Fehler auftreten kann, muss man auch eine Fehlerbehandlung mit integrieren (die 2 blauen Zeilen).

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Address = "$U$42" Then
[COLOR="#FF0000"]    Application.EnableEvents = False[/COLOR]
[COLOR="#0000CD"]    On Error GoTo Err_Change[/COLOR]
    With ActiveSheet
      If .Range("T42") <> "" Then
        .Range("T42") = UCase(Left(.Range("T42"), 1)) & Right(.Range("T42"), Len(.Range("T42")) - 1)
      End If
    End With
    With Sheets("Haushaltskasse")
        With .ListObjects("Tab1Kasse").ListRows.Add().Range
          .Cells(1) = ActiveSheet.Range("S42").Value  'Datum
          .Cells(2) = ActiveSheet.Range("T42").Value  'Art
          .Cells(3) = ActiveSheet.Range("U42").Value  'Betrag
        End With
    End With
    With ActiveSheet
        .Range("S42").Value = ""
        .Range("S42").Activate
        .Range("T42").Value = ""
        .Range("U42").Value = ""
    End With
[COLOR="#0000CD"]Err_Change:[/COLOR]
[COLOR="#FF0000"]    Application.EnableEvents = True[/COLOR]
  End If
End Sub

 

Hallo,

auf dich kann man sich verlassen, besten Dank.
Gruß Rene