Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1804to1808
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

Kommentare zählen

Kommentare zählen
15.01.2021 15:58:57
reiner
Hallo Leute,
https://www.herber.de/bbs/user/143038.xlsb
in dem Beispiel wurden alle Wochentage sowie Mondphasen mit einem Kommentar versehen, insgesamt 67 Kommentare.
  • 
    Sub Kommentarezaehlen()
    Dim Kom As Comment, i%
    For Each Kom In ActiveSheet.Comments
    i = i + 1
    Next
    msg = MsgBox("Das Blatt enthält " & i & " Kommentare")
    End Sub
    

  • Ich will die Anzahl aller Kommentare in einem frei wählbaren Bereich, z.B. vom 12. Januar (G15) bis 15. Februar (D22) zählen
    Set Bereich = Range(Cells(15, 7), Cells(22, 4))
    Bei meiner Recherche bin ich auch auf Vorschläge gestoßen bei denen jede Zelle auch ohne Kommentar mitgezählt wurde, aber das hilft mir nicht weiter.
    mfg
    reiner

    15
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Kommentare zählen
    15.01.2021 16:08:56
    ChrisL
    Hi
    Sub Kommentarezaehlen()
    Dim Kom As Comment, i%
    For Each Kom In ActiveSheet.Comments
    If Not Intersect(Kom.Parent, Range(Cells(15, 7), Cells(22, 4))) _
    Is Nothing Then i = i + 1
    Next Kom
    MsgBox "Das Blatt enthält " & i & " Kommentare"
    End Sub
    
    cu
    Chris
    AW: Kommentare zählen
    15.01.2021 16:17:37
    Rolf
    Hallo Reiner
    Sub Kommentare_zaehlen()
    Dim i As Integer
    Dim rng As Range
    For Each rng In Selection 'oder Bereich
    If Not rng.Comment Is Nothing Then
    i = i + 1
    End If
    Next
    MsgBox i & " Kommentare"
    End Sub
    
    Gruß Rolf
    hallo Chris und Rolf
    15.01.2021 16:38:11
    reiner
    Wenn ich den Kommentar in G15 berücksichtige, zähle ich (von Hand) 40 Kommentare und nicht 12 Kommentare.
    Ich weiß gar nicht warum sich bei euren beiden Lösungen jeweils die Anzahl "12" errechnet?
    Kann es sein dass bei beiden Lösungen jeweils nur der definierte Zellbereich gezählt wird und nicht zeilenweise, dann könnte ich die Lösung evtl. verstehen.
    Ich suche hingegen eine Lösung die als Ergebnis 39 oder 40 (Zelle D22) errechnet
    Anzeige
    AW: hallo Chris und Rolf
    15.01.2021 17:17:33
    Luschi
    Hallo Reiner,
    Set Bereich = Range(Cells(15, 7), Cells(22, 4)) ergibt den Zellbereich '$D$15:$G$22', denn
    Vba macht aus Deiner Vorgabe diesen Bereich: Set Bereich = Range(Cells(15, 4), Cells(22, 7)) -
    und darin gibt es genau 12 Kommentare.
    Gruß von Luschi
    aus klein-Paris
    AW: hallo Chris und Rolf
    15.01.2021 17:53:01
    reiner
    Ja Luschi, das ist wohl das Problem.
    Dann müsste ich eigentlich alle Kommentare an den Wochentage von Montag bis Sonntag in den Zeilen 15 bis 22 zählen und die Kommentare vor dem 12.Januar und nach dem 15. Februar subtrahieren.
    Das werde ich mal testen.
    Danke für deine Erklärung
    AW: hallo Chris und Rolf
    15.01.2021 17:19:05
    ChrisL
    Hi
    Ich muss passen. Wochenende ruft.
    Falls mir niemand zuvorkommt schaue ich am Montag noch einmal rein. Könntest du bitte die Datei als *.xlsx laden (Firewall verhindert Download) und noch wichtiger: Bitte sage uns noch einmal für welchen Bereich genau das Resultat 40 anstelle 12 erwartet wird.
    cu
    Chris
    Anzeige
    AW: hallo Chris und Rolf
    16.01.2021 10:04:47
    Rolf
    Guten morgen reiner,
    wie Yal auch schon schrieb, bleibt eigentlich nur die Ermittlung des Bereichs zwischen 12.Jan und 15.Feb. Dazu habe ich den Teilbereich von 12.Jan dis Zeilenende (B1), den Bereich der kompletten Zeilen (B2) und die letzte Zeile bis 15.Feb (B3) bestimmt. Dann die Bereiche vereinigen und die Schleife drüber laufen lassen.
    Sub Kommentarezaehlen()
    Dim Kom As Comment, i%, Bereich As Range
    Dim rng As Range, B1 As Range, B2 As Range, B3 As Range
    Dim str12Jan As String
    Dim str15Feb As String
    Set Bereich = Range("D14:X23")
    str12Jan = Bereich.Find(what:=44208, LookIn:=xlValues).Offset(0, -2).Address
    str15Feb = Bereich.Find(what:=44242, LookIn:=xlValues).Offset(0, -2).Address
    Set B1 = Range(str12Jan & ":X" & Range(str12Jan).Row)
    Set B2 = Range("D" & Range(str12Jan).Row + 1 & ":X" & Range(str15Feb).Row - 1)
    Set B3 = Range("D" & Range(str15Feb).Row & ":" & str15Feb)
    Set Bereich = Union(B1, B2, B3)
    For Each rng In Bereich
    If Not rng.Comment Is Nothing Then
    i = i + 1
    End If
    Next
    msg = MsgBox("Das Blatt enthält " & i & " Kommentare")
    End Sub
    
    Gruß Rolf
    Anzeige
    AW: hallo Chris und Rolf
    16.01.2021 13:25:36
    reiner
    hallo Rolf,
    daanke für deine Lösung, ich werde sie mir am Wochenende anschauen
    reiner
    AW: Kommentare zählen
    15.01.2021 20:32:41
    Yal
    Moin zusammen,
    ganz einfach in der Idee, ganz kompliziert in der Ausführung: aus Anfang- und Endzelle einen Bereich bestehend aus mehrere Bereiche erzeugen und darin die Kommentar zaehlen.
    War lustig. Ich hatte noch nie mit "Areas" gearbeitet (*).
    Sub Kommentare_zaehlen()
    Dim Bereich As Range
    Set Bereich = RangeGesamt([Tabelle1].Cells(15, 7), [Tabelle1].Cells(22, 4))
    MsgBox ("Der Bereich " & BereichAdresse_auflisten(Bereich) & " enthält " & Komm_count( _
    Bereich) & " Kommentare")
    End Sub
    Function RangeGesamt(R1 As Range, R2 As Range) As Range
    Dim R As Range
    Dim Rx As Range
    If R1.Row = R2.Row Then ' gleiche Zeile
    Set RangeGesamt = Range(R1, R2)
    Else
    If R1.Row > R2.Row Then 'Umgekehrt: bei nächster Gelegenheit, bitte wenden.
    Set R = R1
    Set R1 = R2
    Set R2 = R
    End If
    Set R = RangeRestVomZeile(R1)
    Set Rx = RangeDazwischen(R1, R2)
    If Not Rx Is Nothing Then Set R = Union(R, Rx)
    Set Rx = RangeAnfangVonZeile(R2)
    If Not Rx Is Nothing Then Set R = Union(R, Rx)
    Set RangeGesamt = R
    End If
    End Function
    Function RangeRestVomZeile(R As Range) As Range
    Set RangeRestVomZeile = Intersect(R.Resize(1, 200), R.CurrentRegion)
    End Function
    Function RangeAnfangVonZeile(R As Range) As Range
    Set RangeAnfangVonZeile = Intersect(Range(Cells(R.Row, 1), R), R.CurrentRegion)
    End Function
    Function RangeDazwischen(R1 As Range, R2 As Range) As Range
    If (R2.Row - R1.Row) > 1 Then
    Set RangeDazwischen = Intersect(Range(R1.Offset(1, 0).EntireRow, R2.Offset(-1, 0). _
    EntireRow), Range(R1.CurrentRegion, R2.CurrentRegion))
    ElseIf (R2.Row - R1.Row) 
    Zum Testzweck ist vielleicht folgendes hilfreich
    Sub Test()
    Dim C1, C2, R1, R2, i
    Dim Rn1 As Range
    Dim Rn2 As Range
    Dim R As Range
    Randomize
    For i = 1 To 10
    C1 = CInt(4 + Rnd() * 21)
    C2 = CInt(4 + Rnd() * 21)
    R1 = CInt(13 + Rnd() * 11)
    R2 = CInt(13 + Rnd() * 11)
    Set Rn1 = [Tabelle1].Cells(R1, C1)
    Set Rn2 = [Tabelle1].Cells(R2, C2)
    Set R = RangeGesamt(Rn1, Rn2)
    Debug.Print String(23, "-")
    Debug.Print Rn1.Address(False, False) & ":" & Rn2.Address(False, False), R.Cells.Count & _
    " Cells"
    Debug.Print BereichAdresse_auflisten(R)
    Debug.Print Komm_count(R)
    Next
    End Sub
    
    (*): liegt vielleicht auch daran, dass bei einem korrekten Trennung der Datenhaltung und der Daten-Präsentation solche Spagat nicht braucht.
    Viel Spass damit
    Yal
    Anzeige
    AW: Kommentare zählen
    15.01.2021 23:56:13
    reiner
    hallo Yal,
    da hast du dir aber viel Arbeit gemacht.
    Da benötige ich etwas Zeit um den Code zu verstehen und ihn anzupassen
    danke dir
    reiner
    AW: Kommentare zählen
    16.01.2021 13:44:22
    Yal
    Moin Reiner,
    anzupassen ist dabei wenig:
    mit der Aufruf auf RangeGesamt wird der Gesamte Bereich Rest von erster Zeile, Zeilen dazwischen und Anfang von letzter Zeile zusammengebaut,
    mit Aufruf auf Komm_count werden die Kommentare in den gegebenen Zellen gerechnet.
    Man hätte direkt einer "Walker" von erst gegebenen Zelle bis zum letzten und auf dem Weg die Kommentare zählen, aber der Code wäre wenig wieder verwendbar (wenn diese Code je wieder verwendet wird ;-)
    VG
    Yal
    Anzeige
    alles klar
    16.01.2021 13:58:22
    reiner
    o.T.
    Walker
    16.01.2021 14:48:18
    Yal
    Ach, weil es so schön ist (und mir langeweilig) ist,
    hier die wesentliche einfacherere "Walker"-Methode:
    (eig. die Prüfung und Richtigstellung Z1 vor Z2 sollte innerhalb des Walkers sein)
    Private Function Walker(Z1 As Range, Z2 As Range)
    Dim AktZ As Range
    Dim AnzKom As Integer
    Dim AnzZelle
    'Weil das Ermitteln von Rand-Spalten (Eig. nebensächlich)
    'Problem verursacht: per Hand fixiert:
    Const cErsteSpalte = 4
    Const cLetzteSpalte = 25
    ' starte auf erste Zelle
    Set AktZ = Z1
    ' Mit Zelle, mache
    Do
    DoEvents 'gegen ununterbrechbare endlose Schleife ;-)
    ' +1 falls Kommentar
    AnzZelle = AnzZelle + 1
    AnzKom = AnzKom - Not (AktZ.Comment Is Nothing)
    '    nächste Zelle ermittel und positionieren
    If AktZ.Column = cLetzteSpalte Then
    '        wenn Zelle am Zeilende, dann nächste Zelle ist auf nächste Zeile
    Set AktZ = Z1.Worksheet.Cells(AktZ.Row + 1, cErsteSpalte)
    Else
    '        sonst nächste Zelle rechts
    Set AktZ = AktZ.Offset(0, 1)
    End If
    ' Loop mit Zelle
    Loop While AktZ.Address  Z2.Address
    ' Anzahlzellen mit Kommentar herausgeben
    Walker = Array(AnzKom, AnzZelle)
    End Function
    
    getestet/debugt habe ich mit:
    Public Sub Test()
    Dim C1, C2, R1, R2, i
    Dim Rn1 As Range
    Dim Rn2 As Range
    Dim R As Range
    Dim Erg
    Randomize
    For i = 1 To 10
    C1 = CInt(4 + Rnd() * 21) 'erste Spalte D (=4) letzte Splate Y (=25, -4 => 21)
    C2 = CInt(4 + Rnd() * 21)
    R1 = CInt(13 + Rnd() * 10) 'erste Zeile 13, letzte Zeile 23 (13+10)
    R2 = CInt(13 + Rnd() * 10)
    Set Rn1 = [Tabelle1].Cells(R1, C1)
    Set Rn2 = [Tabelle1].Cells(R2, C2)
    'Die "Walker"-Methodik setzt voraus, dass die Endzelle "nach" der erste ist.
    If Rn1.Row > Rn2.Row Then
    Set R = Rn1
    Set Rn1 = Rn2
    Set Rn2 = R
    End If
    Erg = Walker(Rn1, Rn2)
    Debug.Print String(23, "-")
    Debug.Print Rn1.Address(False, False) & ":" & Rn2.Address(False, False), Erg(1) & "  _
    Cells"
    Debug.Print "Anz. Komm.: ", Erg(0)
    Next
    End Sub
    
    VG Yal
    Anzeige
    AW: Walker
    16.01.2021 15:06:28
    reiner
    danke Yal,
    könntest du mir bitte die von mir eingestellte Beispieldatei mit diesem Makro versehen hochladen?
    reiner
    AW: Walker
    16.01.2021 15:14:29
    Yal
    Hallo Reiner,
    einfach diesen Code in dem VB-Editor für Tabelle1 Copy-pasten. Mehr ist nicht notwendig.
    Das bekommst Du schon hin ;-)
    VG
    Yal

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige