Datumsanzeige mit Auswertung

[M.Wichmann]

Wieso nicht die Eingabe in eine fortlaufende Tabelle. Evtl mit Userform mit Komboboxen für die sich Wiederholenden Texte zur Eingabe. 
Diese lässt sich ja dann nach belieben Filtern bzw mit Pivot auswerten.

[Kuwer]

Hallo Anna,

es gibt ein Tabellenblatt Report, in dem alle Eingaben aus Tabelle1 gespeichert werden, eine Zeile pro Datum.

In das schon vorhandene VBA-Modul des Tabellenblattes Tabelle1 kommt folgender Code:

Microsoft Excel Objekt Tabelle1

Option Explicit 



Private Sub Worksheet_Change(ByVal Target As Range) 

 Static varZeile As Variant 

 On Error Resume Next 

 Application.EnableEvents = False 

 With Worksheets("Reports") 

   If Target.Address = "$G$1" Then 

     varZeile = Application.Match(CDbl(Target.Value), .Columns(1), 0) 

     If IsError(varZeile) Then 

       varZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 

       .Cells(varZeile, 1).Value = Target.Value 

       Me.Range("B4:G22") = "" 

     Else 

       Me.Cells(4, 2).Value = .Cells(varZeile, 2).Value 

       Me.Cells(4, 3).Value = .Cells(varZeile, 3).Value 

       Me.Cells(5, 2).Value = .Cells(varZeile, 4).Value 

       Me.Cells(5, 3).Value = .Cells(varZeile, 5).Value 

       Me.Cells(6, 2).Value = .Cells(varZeile, 6).Value 

       Me.Cells(6, 3).Value = .Cells(varZeile, 7).Value 

       Me.Cells(9, 2).Value = .Cells(varZeile, 8).Value 

       Me.Cells(9, 3).Value = .Cells(varZeile, 9).Value 

       Me.Cells(10, 2).Value = .Cells(varZeile, 10).Value 

       Me.Cells(10, 3).Value = .Cells(varZeile, 11).Value 

       Me.Cells(11, 2).Value = .Cells(varZeile, 12).Value 

       Me.Cells(11, 3).Value = .Cells(varZeile, 13).Value 

       Me.Cells(12, 2).Value = .Cells(varZeile, 14).Value 

       Me.Cells(12, 3).Value = .Cells(varZeile, 15).Value 

       Me.Cells(13, 2).Value = .Cells(varZeile, 16).Value 

       Me.Cells(13, 3).Value = .Cells(varZeile, 17).Value 

       Me.Cells(14, 2).Value = .Cells(varZeile, 18).Value 

       Me.Cells(14, 3).Value = .Cells(varZeile, 19).Value 

       Me.Cells(15, 2).Value = .Cells(varZeile, 20).Value 

       Me.Cells(15, 3).Value = .Cells(varZeile, 21).Value 

       Me.Cells(18, 2).Value = .Cells(varZeile, 22).Value 

       Me.Cells(18, 3).Value = .Cells(varZeile, 23).Value 

       Me.Cells(19, 2).Value = .Cells(varZeile, 24).Value 

       Me.Cells(19, 3).Value = .Cells(varZeile, 25).Value 

       Me.Cells(20, 2).Value = .Cells(varZeile, 26).Value 

       Me.Cells(20, 3).Value = .Cells(varZeile, 27).Value 

       Me.Cells(21, 2).Value = .Cells(varZeile, 28).Value 

       Me.Cells(21, 3).Value = .Cells(varZeile, 29).Value 

       Me.Cells(22, 2).Value = .Cells(varZeile, 30).Value 

       Me.Cells(22, 3).Value = .Cells(varZeile, 31).Value 

     End If 



   Else 

     If varZeile < 4 Then 

       varZeile = Application.Match(CDbl(Target.Value), .Columns(1), 0) 

     End If 

     .Cells(varZeile, 2).Value = Me.Cells(4, 2).Value 

     .Cells(varZeile, 3).Value = Me.Cells(4, 3).Value 

     .Cells(varZeile, 4).Value = Me.Cells(5, 2).Value 

     .Cells(varZeile, 5).Value = Me.Cells(5, 3).Value 

     .Cells(varZeile, 6).Value = Me.Cells(6, 2).Value 

     .Cells(varZeile, 7).Value = Me.Cells(6, 3).Value 

     .Cells(varZeile, 8).Value = Me.Cells(9, 2).Value 

     .Cells(varZeile, 9).Value = Me.Cells(9, 3).Value 

     .Cells(varZeile, 10).Value = Me.Cells(10, 2).Value 

     .Cells(varZeile, 11).Value = Me.Cells(10, 3).Value 

     .Cells(varZeile, 12).Value = Me.Cells(11, 2).Value 

     .Cells(varZeile, 13).Value = Me.Cells(11, 3).Value 

     .Cells(varZeile, 14).Value = Me.Cells(12, 2).Value 

     .Cells(varZeile, 15).Value = Me.Cells(12, 3).Value 

     .Cells(varZeile, 16).Value = Me.Cells(13, 2).Value 

     .Cells(varZeile, 17).Value = Me.Cells(13, 3).Value 

     .Cells(varZeile, 18).Value = Me.Cells(14, 2).Value 

     .Cells(varZeile, 19).Value = Me.Cells(14, 3).Value 

     .Cells(varZeile, 20).Value = Me.Cells(15, 2).Value 

     .Cells(varZeile, 21).Value = Me.Cells(15, 3).Value 

     .Cells(varZeile, 22).Value = Me.Cells(18, 2).Value 

     .Cells(varZeile, 23).Value = Me.Cells(18, 3).Value 

     .Cells(varZeile, 24).Value = Me.Cells(19, 2).Value 

     .Cells(varZeile, 25).Value = Me.Cells(19, 3).Value 

     .Cells(varZeile, 26).Value = Me.Cells(20, 2).Value 

     .Cells(varZeile, 27).Value = Me.Cells(20, 3).Value 

     .Cells(varZeile, 28).Value = Me.Cells(21, 2).Value 

     .Cells(varZeile, 29).Value = Me.Cells(21, 3).Value 

     .Cells(varZeile, 30).Value = Me.Cells(22, 2).Value 

     .Cells(varZeile, 31).Value = Me.Cells(22, 3).Value 

   End If 

 End With 

 Application.EnableEvents = True 

 On Error GoTo 0 

End Sub 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Die Datei muss als Makrodatei (Endung .xlsm) gespeichert werden.


  Datumsanzeige mit Auswertung Kuwer.xlsm (Größe: 20,1 KB / Downloads: 7)

Gruß Uwe

[FrauAnna]

Viel Dank Uwe das ist der Hammer!
Ich versuche das gleich mal auf alle meine Punkte Anzupassen!