Office: (Office 2010) Kommentar in Zellen per VBA

Hallo zusammen,

ich habe eine Excel-Mappe die aus mehreren Tabellenreitern besteht. Ich habe euch mal eine vereinfachte Version angehängt.
Ein Tabellenreiter "Übersicht" fasst quasi den Umsatz nach Segmenten für die einzelnen Quartale zusammen.
in den anderen Tabellenreitern, die jeweils den Namen des Segmentes haben, enthalten eine örtliche Angabe (Bundesländer) des Umsatzes. Dort steht einfach nur drin, wo der Umsatz erfolgte.

Ich würde nun gerne in jeder Zelle des Reiters "Übersicht", wo eine Zahl drin steht, ein Kommentar eingefügt bekommen, in dem drin steht wie sich der Betrag auf die Bundesländer aufteilt.
Händisch würde das enorm fiel Zeit in Anspruch nehmen. Leider kenne ich mich mit VBA nur sehr schlecht aus. Kann mir da jemand helfen, wie ich das mit VBA quasi automatisch erledigen kann?
Schön wäre, wenn der Umsatz eines Bundeslandes null beträgt, diese Angabe im Kommentar nicht erscheint und wenn unter "Baden-Würtemberg" ein oder zwei weitere Bundesländer hinzugefügt werden, diese dann auch im Kommentar erscheinen.

Vielen Dank schon mal, für jede Hilfe

 

Hi,

eine Möglichkeit:

Code:

Sub Kommentare()
    Dim wksTab As Worksheet
    Dim lngZeile As Long
    Dim intSpalte As Integer
    Dim lngZeile2 As Long
    Dim strText As String
    For lngZeile = 3 To 5
        With Worksheets(Worksheets("Übersicht").Cells(lngZeile, 2).Value)
            For intSpalte = 4 To 7
                For lngZeile2 = 5 To 13
                    If .Cells(lngZeile2, intSpalte + 1) <> "" Then strText = _
                        strText & ", " & .Cells(lngZeile2, 4)
                Next lngZeile2
                If Len(strText) > 2 Then
                    strText = Mid(strText, 3)
                    If Not Worksheets("Übersicht").Cells(lngZeile, intSpalte).Comment Is Nothing Then
                        Worksheets("Übersicht").Cells(lngZeile, intSpalte).Comment.Text Text:=strText
                    Else
                        Worksheets("Übersicht").Cells(lngZeile, intSpalte).AddComment Text:=strText
                        
                    End If
                End If
                strText = ""
            Next intSpalte
        End With
    Next lngZeile
End Sub

Bis später,
Karin

 

Hi Karin,

danke! Das ist schon fast das, was ich meinte.
Kann man den Code auch so erweitern, dass die Beträge auch im Kommentar erscheinen und die Bundesländer untereinander aufgelistet werden?

Kann man das auch so erweitern, dass wenn ein Segment und ein Tabellenreiter hinzukommt, auch dafür die Kommentare erzeugt werden?

Gruß
Lukas

 

Hi Lukas,

ich habe den Code wie folgt erweitert: es wird die Anzahl an Zeilen in Spalte B ermittelt und die Anzahl an Spalten in Zeile 2 und davon ausgehend die Schleifen durchlaufen:

Code:

Sub Kommentare()
    Dim wksTab As Worksheet
    Dim lngZeile As Long
    Dim intSpalte As Integer
    Dim lngZeile2 As Long
    Dim strText As String
    Dim lngLetzte As Long
    Dim intLetzte As Integer
    ' letzte belegte Zeile in Spalte B
    lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)
    ' letzte belegte Spalte in Zeile 2
    intLetzte = IIf(IsEmpty(Cells(2, Columns.Count)), _
        Cells(2, Columns.Count).End(xlToLeft).Column, Columns.Count)
    ' Zeile 3 bis letzte belegte Zeile
    For lngZeile = 3 To lngLetzte
        With Worksheets(Worksheets("Übersicht").Cells(lngZeile, 2).Value)
            ' Spalte 4 (D) bis letzte belegte Spalte
            For intSpalte = 4 To intLetzte
                For lngZeile2 = 5 To 13
                    If .Cells(lngZeile2, intSpalte + 1) <> "" Then strText = _
                        strText & vbLf & .Cells(lngZeile2, 4) & " " & _
                        Round(.Cells(lngZeile2, intSpalte + 1), 2)
                Next lngZeile2
                If Len(strText) > 1 Then
                    strText = Mid(strText, 2)
                    If Not Worksheets("Übersicht").Cells(lngZeile, intSpalte).Comment Is Nothing Then
                        Worksheets("Übersicht").Cells(lngZeile, intSpalte).Comment.Text Text:=strText
                    Else
                        Worksheets("Übersicht").Cells(lngZeile, intSpalte).AddComment Text:=strText
                    End If
                    Worksheets("Übersicht").Cells(lngZeile, intSpalte).Comment.Shape. _
                        OLEFormat.Object.AutoSize = True
                End If
                strText = ""
            Next intSpalte
        End With
    Next lngZeile
End Sub

Im Code wird aber nicht geprüft, ob das betreffende Tabellenblatt vorhanden ist - falls nicht, ergibt es einen Fehler.


Bis später,
Karin