Daten suchen und in eine zweite Tabelle kopieren per CommandButton

Question

Hallo ich heiße Jörn,

ich habe zwei Tabellen, Fahrtenbuch und Stundenabrechnung.

Ich möchte aus dem Fahrtenbuch bestimmte Daten die zwischen 2 Datumsangaben stehen in die Tabelle Stunden per Button übertragen.  

als Link die Tabellen mit der ausführlichen Erklärung 

https://supportnet.de/forum/?qa=blob&qa_blobid=6434315339220036744

ich verstehe von Excel ein wenig von vba noch weniger.

vielen Dank

Jörn

Answer 1

Hallo Jörn,

a)  aus meiner Sicht könntest Du es Dir ein wenig einfacher machen, wenn Du alles nur in einer Tabelle -           Fahrtenbuch - darstellst.

b)  habe ich ein Verständnisproblem wie z.B. am 01, Jan. AB = 12:58 und wieder AB = 16:00 Uhr - wenn man die Orte dazu nimmt, vermute ich mal das eine Fahrt dazwischen lag... und die AN fehlt - Falls dem so ist, sollte man da einen Fehlerhinweis einbauen, dass die Stempelzeiten immer im Wechsel sind - außer es gibt für Dich begründete Zeiten

c) bin ich was die Spesen nicht auf dem Laufenden - zu früheren Zeiten musste man den Zeitpunkt der Grenzüberschreitung ins Ausland für die Auslandsspesen ansetzen. Je nach aktueller Situation müsste man für diese Spesen sich noch was einfallen lassen.Das es Pauschalsätze gibt ist mir bekannt und könnte man als Art Tabelle mit einbauen

d) Aus meiner Sicht benötigt das auch keine Button - sprich VBA-Lösung - und sollte mit Formeln lösbar sein. Die nächste Frage wäre - soll etwas ausgedruckt werden oder bleibt es bei den Werten in Excel oder erfolgt eine Datenübertragung über eine Schnittstelle in ein anderes Programm?

e) die Pause selbst wurde einfach als Stundenangabe in die Spalte Pause eingetragen. Müsste man da nicht die Zeitangabe dazu bringen. Falls nein... soll man einfach die Endzeit minus Anfangszeit = Bruttozeit minus Pause = Nettozeit rechnen? Reicht das wirklich für eine Prüfung?

f) soll es das nur für ein Fahrzeug geben oder steht da ne ganze Flotte auf dem Hof und sollen so bearbeitet werden? Falls da neben dem Fahrtenbuch noch weitere Wünsche sein sollten, die aber noch nicht ausgesprochen wurden, dann wäre es dennoch besser dieses vorher einzubauen, da es sich vom Platz und der Übersichtlichkeit her einfacher händeln lässt, wie später irgendwelche andere Parameter einzusetzen und auszuwerten (z.B. LKW-Km-Leistung).

Ich selbst werde allerdings nicht vor Montag mal ein kleines Konstrukt erstellen können, da ich übers Wochenende unterwegs bin.

In diesem Sinne.. have a nice WE... und bis denne.. Gruß Helmut

Answer 2

Hallo Helmut,

erst mal vielen Dank für deine Antwort.

Du hast natürlich recht, das Fahrtenbuch ist nicht geeignet zur Weitergabe an ein Prüforgan es ist nur als Gedächtnisstütze für mich gedacht.

Sollte mein Disponent mal anrufen und fragen warum die Beladung, oder sonst was, bei einen Kunden länger gedauert hat kann ich es mittels meines Fahrtenbuch nachvollziehen. Beim Original ist noch eine Spalte Bemerkung, in der ich Störungen eintragen kann. Früher habe ich die Fahrten in mein Terminbuch eingetragen.  

Mir geht es darum das ich die Daten die ich in meiner Stundenabrechnung eingebe  ja auch in meinem persönlichen Fahrtenbuch habe und diese dadurch nicht doppelt eingeben muss beziehungsweise kann ich dann meine Stundenabrechnung einmal im Monat aktualisieren.  

Arbeitsbeginn und wo, Arbeitsende und wo plus die Pause  Diese Daten würde ich gern mittels eines Button oder Formel in meine Stundenabrechnung an richtiger Stelle übertragen, wenn möglich.

Die Stundenabrechnung kann nicht geändert werden, von Firma vorgegeben.

Dein Einwand wegen der Spesen ist natürlich richtig. Wir holen uns die Differenz der Auslandsspesen übers Finanzamt zurück.

Ich muss natürlich dazu sagen das es für jeden Monat ein Tabellenblatt gibt.

Die Stundenabrechnung sende ich per E-Mail an unsere Buchhaltung.

Einige Fahrer schreiben die Stundenabrechnung mit der Hand und müssen alles selber ausrechnen das habe ich per Excel so weit wie möglich automatisiert, ist für Profis wie Du bestimmt verbesserungswürdig aber ich bin zufrieden.

Ich wünsch dir auch ein schönes Wochenende

Grüß Jörn

Answer 3

Hallo Jörn,

ich hab mir auch mal Gedanken gemacht und einen kleinen Code geschrieben. Probier ihn mal aus ob er das macht, was du willst:

Sub Uebertragen()
  
  Dim FBuch As Worksheet, Std As Worksheet
  Dim Ab As Date, An As Date, Datum As Date
  Dim Ort1 As String, Ort2 As String
  
  Set FBuch = Sheets("Fahrtenbuch")
  'Set Std = Sheets("Jan")
  
  FBuch.Select
  
  For Each c In Range("F:F")
    
    If c = "Beginn" Then
      DatenVorhanden = True
      Datum = Range("B" & c.Row)
      Set Std = Sheets(Month(Datum))
      Ab = Zeitrunden(Range("D" & c.Row))
      Ort1 = Range("G" & c.Row)
      Pause = 0
    End If
    If Range("I" & c.Row) <> "" And Datum > 0 Then
      Pause = Pause + Range("I" & c.Row)
    End If
    If c = "Ende" And Datum > 0 Then
      An = Zeitrunden(Range("C" & c.Row))
      Ort2 = Range("G" & c.Row)
      s = Day(Datum)
      r = Application.Match(CDbl(Datum), Std.Range("B:B"), 0)
      If Not IsError(r) Then
      Std.Range("E" & r) = Ort1
      Std.Range("F" & r) = Ort2
      Std.Range("G" & r) = Ab
      Std.Range("H" & r) = An
      Std.Range("K" & r) = Pause
      End If
    End If
    
    If c = "" And DatenVorhanden Then Exit For
  Next c
  
  Std.Select
End Sub
Function Zeitrunden(Zeit As Date) As Date
  
  Dim h As Byte, m2 As Byte
  
  h = Hour(Zeit)
  m = Minute(Zeit)
  If m <= 15 Then m2 = 0
  If m > 15 And m < 45 Then m2 = 30
  If m >= 45 Then h = h + 1
  
  Zeitrunden = TimeValue(h & ":" & m2)
  
End Function

Gruß Mr. K.

Answer 4

Hallo Mr. K.

Klasse! 

In der Testdatei  funktioniert der Code einwandfrei  für die Originaldatei muss wohl noch einiges angepasst werden, dort gibt es kein Tabellenblatt "Stunden" sondern für jeden Monat eins. Habe versucht den Sheets Stunden in Jan zu ändern, hat nicht funktioniert, es wird aber auch kein Fehler angezeigt.

Da ich von vba nicht sehr viel verstehe würde ich mich freuen wenn du das erledigen könntest.

Originaldatei als link  https://supportnet.de/forum/?qa=blob&qa_blobid=17717606063808417180

Vielen Dank

Gruß Jörn

Answer 5

Hallo Jörn,

hab den Code oben nochmal ein wenig überarbeitet. Versuchs erneut.

Gruß Mr. K.

Answer 6

Du hast übrigens noch einen Formelfehler auf dem Tabellenblatt Spesen. An den Tagen wo du nur 12€ bekommst, kannst du auch im Ausland nur den anteiligen Tagessatz ansetzen. Für die anteiligen Tagessätze hast du jedoch noch keine Tabelle gebaut. Das solltest du noch nachholen, sonst rechnest du u.U. zu viel ab.

Answer 7

Hallo Mr. K.

Der Code funktioniert perfekt.

Ich bedanke mich für deine Mühe.

Gruß Jörn.

Answer 8

Hallo Anonym,

du hast recht, die Tabelle muss ich noch einfügen.

Gruß Jörn

Answer 9

Hallo,

besonderes Hallo an Mr. K. 

der Code funktioniert sehr gut.

ich würde den Code gern noch etwas erweitern.

Wenn möglich

Ich möchte im Fahrtenbuch die Standzeiten sprich, die Belade.- u. Abladezeit, pro Tag zusammen zählen und sie dann mit den anderen Daten in die Zeile Standzeiten übertragen. Das heißt die Zeiten zwischen den An u. Abfahrten bei den Kunden.

https://supportnet.de/forum/?qa=blob&qa_blobid=9454637196862467371

Gruß Jörn

Answer 10

Hallo Jörn,

habe den Code um die Standzeit ergänzt. Hier der neue Code:

Sub Uebertragen()
  
  Dim FBuch As Worksheet, Std As Worksheet
  Dim Ab As Date, An As Date, Datum As Date, Standzeit as Date
  Dim Ort1 As String, Ort2 As String
  
  Set FBuch = Sheets("Fahrtenbuch")
  'Set Std = Sheets("Jan")
  
  FBuch.Select
  
  For Each c In Range("F:F")
    
    If c = "Beginn" Then
      Datenvorhanden = True
      Datum = Range("B" & c.Row)
      Set Std = Sheets(Month(Datum))
      Ab = Zeitrunden(Range("D" & c.Row))
      Ort1 = Range("G" & c.Row)
      Pause = 0
      Standzeit = 0
    End If
    If Range("I" & c.Row) <> "" And Datum > 0 Then
      Pause = Pause + Range("I" & c.Row)
    End If
    If c <> "Beginn" And c <> "Ende" And Datenvorhanden = True Then
      Standzeit = Standzeit + Range("D" & c.Row) - Range("C" & c.Row)
    End If
    If c = "Ende" And Datum > 0 Then
      An = Zeitrunden(Range("C" & c.Row))
      Ort2 = Range("G" & c.Row)
      s = Day(Datum)
      r = Application.Match(CDbl(Datum), Std.Range("B:B"), 0)
      If Not IsError(r) Then
      Std.Range("E" & r) = Ort1
      Std.Range("F" & r) = Ort2
      Std.Range("G" & r) = Ab
      Std.Range("H" & r) = An
      Std.Range("K" & r) = Pause
      Std.Range("L" & r) = Zeitrunden(Standzeit) * 24
      End If
    End If
    
    If c = "" And Datenvorhanden Then Exit For
  Next c
  
  Std.Select
End Sub
Function Zeitrunden(Zeit As Date) As Date
  
  Dim h As Byte, m2 As Byte
  
  h = Hour(Zeit)
  m = Minute(Zeit)
  If m <= 15 Then m2 = 0
  If m > 15 And m < 45 Then m2 = 30
  If m >= 45 Then h = h + 1
  
  Zeitrunden = TimeValue(h & ":" & m2)
  
End Function

Das setzt aber voraus, dass jedes Monats-Tabellenblatt diese Spalte besitzt. Im Moment gibts die Spalte nur im Dezember. Eine Frage: Am 01. Dezember die halbe Stunde in Stellingen. Ist das jetzt Standzeit oder Pause? wenn das Pause ist musst du die noch von der Standzeit abziehen. Also so:

Std.Range("L" & r) = Zeitrunden(Standzeit) * 24 - Pause

Gruß Mr. K.