ich möchte ein Bericht aufarbeiten, um Zeit zu sparen. Der Bericht soll Zeitveränderungen an verschiedenen Datumswerten von Typen aufzeigen. Wird also ein anderes Datum eingestellt dann soll aus einber Liste die Gesamtveränderung an diesem Datum für einen bestimmten Ort angezeigt werden. Das wäre alles mit einer Summewenns zu regeln, wenn es da nicht ein kleines Problem gäbe. Wenn es Zeitveränderungen gibt, dann müssen diese in der Zelle als Kommentar aufgesplittet werden.
Summe: 1,2 dann steht im Kommentar = 0,4 Thema1 , o,4 Thema 2 , 0,4 Thema 3
Dann sieht man nach Datumseingabe direkt, wie sich die Veränderung zusammensetzt. Mit einer Do until Schleife bis zur ersten Leerzelle in Blatt 1 ist mir das schon gelungen. Nur ich gehe davon aus, dass nach tausenden Dateninputzeilen eine Neuberechnung lang dauern würde. Deswegen wollte ich die FindNext Methode nutzen, die aus mir unerfindlichen Gründen es einfach nicht mitmacht. Vielleicht hat ja jemand von euch eine Idee wie man die FindNext Methode dazu bekommt oder hat eine elegantere Lösung. Ich habe beide Varianten als Module erstellt. Test ist die nicht laufende Funktion und Test1 läuft.
Das Kommentarfeld soll dann auch noch auto gesized werden. Dazu lässt er sich auch nicht verleiten.
Das nicht funktionierende Programm:
Function Test(Minutenspalte As Range, Datum As Range, Datumspalte As Range, Typ As Range, _
Typspalte As Range, Ort As Range, Ortspalte As Range)
Application.Volatile
Test = Application.WorksheetFunction.SumIfs(Minutenspalte, Typspalte, Typ, Ortspalte, Ort, _
Datumspalte, Datum)
If Test 0 Then
With Worksheets(1).Range("A:A")
Set c = .Find(Typ, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Value = Typ And .Cells(c.Row, 3) = Ort And .Cells(c.Row, 6) = Datum Then
Kommentar1 = Kommentar1 & .Cells(c.Row, 2) & " " & .Cells(c.Row, 4) & " " & _
_
_
_
_
_
_
.Cells(c.Row, 5) & Chr(13) & Chr(10)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
With Application.ThisCell
.ClearComments
.AddComment
.Comment.Text Text:=Kommentar1
.Comment.Shape.TextFrame.AutoSize = True
End With
Else
With Application.ThisCell
.ClearComments
End With
End If
End Function
Die funktionierende Funktion:
Function Test1(Minutenspalte As Range, Datum As Range, Datumspalte As Range, Typ As Range, _
Typspalte As Range, Ort As Range, Ortspalte As Range)
Application.Volatile
Test1 = Application.WorksheetFunction.SumIfs(Minutenspalte, Typspalte, Typ, Ortspalte, Ort, _
Datumspalte, Datum)
If Test1 0 Then
x = 2
With ThisWorkbook.Sheets(1)
Do Until .Cells(x, 1) = ""
If .Cells(x, 1) = Typ And .Cells(x, 3) = Ort And .Cells(x, 6) = Datum Then
Kommentar1 = Kommentar1 & .Cells(x, 2) & " " & .Cells(x, 4) & " " & .Cells(x, 5) _
_
_
_
_
_
_
& Chr(13) & Chr(10)
End If
x = x + 1
Loop
End With
With Application.ThisCell
.ClearComments
.AddComment
.Comment.Text Text:=Kommentar1
.Comment.Shape.TextFrame.AutoSize = True
End With
Else
With Application.ThisCell
.ClearComments
End With
End If
End Function
Viele Grüße
K.