Mar 03, 2016, updated at Mar 04, 2016 (UTC)

1654

Inhalt eines Kommentars pro Zelle zählen

Hallo zusammen,
ich habe eine Excel Tabelle, in der einige Werte stehen. Pro Zelle wurde per Kommentarfunktion einen bzw. mehreren Namen hinterlegt. Beispiel:

Müller
Maier
Schulz

Nun würde ich gerne die Anzahl der Einträge als Wert in die Zelle schreiben lassen:

Ich würde fast Wetten, dass es über VB als Funktion möglich ist. Aber mir fehlt der Ansatz, wie man solch eine Funktion aufbaut.

Gruß,
Dani

Please also mark the comments that contributed to the solution of the article

Content-Key: 298043

Url: https://administrator.de/contentid/298043

Printed on: April 18, 2024 at 05:04 o'clock

9 Comments

Latest comment

Moin Dani,
z.B. als Funktionsmakro das du als Formel benutzen kannst:

Public Function CountCommentLines(rng As Range) As Integer
    On Error GoTo Error
    If rng.Comment.Text <> "" Then  
        CountCommentLines = UBound(Split(rng.Comment.Text, vbLf)) + 1
    Else
        CountCommentLines = 0
    End If
    Exit Function
Error:
    CountCommentLines = 0
End Function

Formel ist dann z.B.

=CountCommentLines(A1)

Gruß jodel32

Hi jodel32,
du bist der Beste. Ich hätte es komplizierter vorgestellt.
Die Funktion läuft wie eine Eins. Allerdings wird nach Kommentaränderung die Zahl im Feld nicht aktualisiert, obwohl ich eigentlich mit ENTER ins nächste Feld springe. Ich denke mal, das ist eine Eigenheit bei den Kommentaren?!

Gruß,
Dani

Zitat von @Dani:
Die Funktion läuft wie eine Eins. Allerdings wird nach Kommentaränderung die Zahl im Feld nicht aktualisiert, obwohl ich eigentlich mit ENTER ins nächste Feld springe. Ich denke mal, das ist eine Eigenheit bei den Kommentaren?!

Ja die triggern kein Update für die Berechnung von Formeln, ich überlege mir gleich mal einen Workaround dafür.

Hallo Dani!

Wenn Du nach der Eingabe in eine andere Zelle wechselst, dann sollte es z.B. so gehen:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("B:B").Calculate  
End Sub

Und in den Formelcode noch das hier einfügen:

Application.Volatile

Gruß Dieter

Guten Morgen,
vielen Dank für die Ergänzung. Leider passiert nach wie vor nichts, beim Wechseln der Zelle. Der Code sieht aktuell so aus:

Public Function CountCommentLines(rng As Range) As Integer
    On Error GoTo Error
    If rng.Comment.Text <> "" Then  
        CountCommentLines = UBound(Split(rng.Comment.Text, vbLf)) + 1
    Else
        CountCommentLines = 0
    End If
    CountCommentLines = CountCommentLines - 1
    Application.Volatile
    Exit Function
Error:
    CountCommentLines = 0
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Columns("P1:P33").Calculate  
End Sub

Abgelegt habe ich das Ganze in einem Module.

Gruß,
Dani

Zitat von @Dani:
Abgelegt habe ich das Ganze in einem Module.

Das ist nicht richtig. Die Function kannst du dort lassen, aber die Worksheet_Selectionchange_Sub muss in den Codeabschnitt des Worksheets, damit das Event fired.

Und das Application.Volatile fehlt am Anfang der Function.

Hallo Dani!

Sorry, hätte ich besser erklären sollen

, was Jodel erfreulicher Weise inzwischen nachgeholt hat

Gruß Dieter

PS.
ändere

Columns("P1:P33").Calculate

nach

Columns("P:P").Calculate   
'oder  
Range("P1:P33").Calculate   

Hallo ihr zwei,

Und das Application.Volatile fehlt am Anfang der Function.

Wusste ich nicht, ich hab's wie oben gepostet einfach ans Ende gestellt.

aber die Worksheet_Selectionchange_Sub muss in den Codeabschnitt des Worksheets, damit das Event fired.

Ah... das war mich nicht klar. Danke.

Ich arbeite die Änderungen später ein und poste den funktionieren Code hier nochmals.

Gruß,
Dani

Untenstehend die finale Lösung für meine Frage.

Zerst habe ich ein neues Modul in der betroffenen Exceldatei angelegt mit folgenden Inhalt:

Public Function CountCommentLines(rng As Range) As Integer
    Application.Volatile
    On Error GoTo Error
    If rng.Comment.Text <> "" Then  
        CountCommentLines = UBound(Split(rng.Comment.Text, vbLf)) + 1
    Else
        CountCommentLines = 0
    End If
    CountCommentLines = CountCommentLines - 1
    
    Exit Function
Error:
    CountCommentLines = 0
End Function

In der jeweiligen Arbeitsmappe per Doppelklick aufrufen und diesen Code einfügen:

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
    Columns("A:Z").Calculate  
End Sub

In Zeile 2 kann der Bereich entsprechend verkleinert bzw. vergrößtert werden.

Vielen Dank nochmal an euch beide! Schönes Wochende!

Gruß,
Dani

German solved Question VB for Applications Development