Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Funktion mit Kommentaränderung

Funktion mit Kommentaränderung
21.02.2016 21:02:10
K.
Hallo zusammen,
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.

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Funktion mit Kommentaränderung
22.02.2016 17:14:30
K.
noch ned gelöst. Durch meinen eigenen Fehler als erledigt deklariert!

AW: Funktion mit Kommentaränderung
22.02.2016 19:26:51
Michael
Hi K,
das Ganze mit volatilen Funktionen zu triggern, halte ich für etwas unglücklich.
Wenn es denn schon "automatisch" gehen muß, finde ich ein WorksheetChange auf die Datumszelle geschickter.
Meine Sub leiert die Orte und Typen durch und schreibt die Ergebnisse jeweils rein:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim orte As Variant, typ As Variant, datum As Date
Dim t&, i&, o&, tmax&, gmax&
Dim such$
Dim c As Range
Dim firstAddress As String, Kommentar1 As String
Dim sh1 As Worksheet
Dim wert#
'Stop
If Target.Address(0, 0)  "J3" Then Exit Sub
Set sh1 = Sheets(1)
orte = Range("B1:F1")
tmax = Range("A1")
gmax = sh1.Range("A" & Rows.Count).End(xlUp).Row
For t = 2 To 1 + tmax
typ = Range("A" & t)
For o = 1 To 5
i = 0
wert = 0
such = typ & orte(1, o) & Target.Value2
MsgBox such
Kommentar1 = ""
With sh1.Range("G2:G" & gmax)
Set c = .Find(such, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
i = i + 1
wert = wert + sh1.Cells(c.Row, 2)
If i > 1 Then Kommentar1 = Kommentar1 & vbCrLf
Kommentar1 = Kommentar1 & sh1.Cells(c.Row, 2) & " " & _
sh1.Cells(c.Row, 4) & " " & sh1.Cells(c.Row, 5)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address  firstAddress
End If
End With
Application.EnableEvents = False
Cells(t, o + 1).Value = wert
If Kommentar1  "" Then
With Cells(t, o + 1)
.ClearComments
.AddComment
.Comment.Text Text:=Kommentar1
.Comment.Shape.TextFrame.AutoSize = True
End With
Else
Cells(t, o + 1).ClearComments
End If
Application.EnableEvents = True
Next
Next
End Sub
Die Orte kann man zur Not auch noch "dynamisieren"...
Der Knackpunkt ist, daß ich eine Hilfsspalte G angelegt habe mit der Formel
=A2&C2&F2

Sie enthält also ALLE Suchbegriffe auf einmal, so daß ein Suchen mit anschließendem Vergleich anderer Spalten entfällt.
Warum das .Findnext(c) in Deiner Suchfunktion nichts mehr findet, weiß ich nicht - vielleicht geht es grundsätzlich nicht recht innerhalb einer Function, aber da können sich Berufenere dazu äußern.
Allerdings bin ich bei der Adaption Deines Codes darübergestolpert, daß
With Worksheets(1).Range("A:A")

*natürlich* anschließend beim
Kommentar1 = Kommentar1 & .Cells(c.Row, 2) & " " & .Cells(c.Row, 4)

nichts zurückgibt, denn der Range A:A hat nur eine Spalte.
Hier die Datei: https://www.herber.de/bbs/user/103784.xlsm
Schöne Grüße,
Michael
P.S.: Deine Variablen waren nicht sauber deklariert - bitte immer mit option explicit arbeiten!

Anzeige
AW: Funktion mit Kommentaränderung
22.02.2016 20:35:25
K.
Hallo Michael,
erstmal vielen Dank für deine Hilfe! Der Hintergrund meiner Funktion, dass dadurch schon die Zellen,
die diese Funktion haben sollen, eingegrenzt werden. Ich werde mit der FindNext Methode noch ein wenig rumprobieren. Vielleicht bringe ich die Funktion ja noch dazu. Für die Hinweise bin ich dankbar. Bei steigender Zeilenanzahl könnte diese Hilfsspalte die Makrolaufzeit geringer halten.
Ich gelobe Besserung was die Deklaration betrifft! Ich mache das immer im Nachgang :D
Viele Grüße
K.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige