Создание динамических комментариев VBA

Я пытаюсь улучшить свою диаграмму ГАНТА в Excel с помощью VBA. На данный момент я использую только условное форматирование, но мне нужно показать значения, даты и статус платежа по проекту в поле комментариев, которое будет получать данные из трех разных рабочих листов в моей книге: Estudos, Projetos и Obras.

Даты платежей показаны на диаграмме ГАНТТ красным цветом. Если платеж находится в строках 4+3*i, источником является Estudos, если платеж находится в строках 5+3*i, источником является Projetos, а если в строках 6+3*i, источником является Obras.

Текущая диаграмма Ганта.

Моя идея заключалась в том, чтобы зациклить все красные ячейки, используя три разные матрицы, по одной для каждого источника рабочего листа, но, поскольку я новичок в программировании VBA, я не могу заставить это работать. Синтаксис и объекты очень специфичны.

Помогите мне, пожалуйста!

Рабочий лист Estudos.

Выше приведено изображение рабочего листа Estudos, откуда комментарий будет получать свои значения. Мне нужно написать как дату, так и сумму каждого платежа, показанного в его конкретной красной ячейке, расположенной на диаграмме ГАНТА.

Это то, что у меня есть до сих пор, что он делает, так это вставляет общий текст «данных» в поле комментария в каждую красную ячейку.

            Sub AtualizaComent()

            ' variaveis
            Dim rng1     As Range
            Dim celula   As Range
            Dim estudos  As Range
            Dim projetos As Range
            Dim obras    As Range
            Dim etapa    As String
            Dim data     As String
            Dim valor    As String
            Dim i, j, k, l, m, n As Integer

            ' inicializaçao
            Set rng1 = Range("T4:APV726")
            Set estudos = Worksheets("Operacional - Pag Estudos").Cells(4, 8)
            Set projetos = Worksheets("Operacional - Pag Projetos").Cells(4, 8)
            Set obras = Worksheets("Operacional - Pag Obras").Cells(4, 8)
            i = 0
            j = 0
            k = 0
            l = 0
            m = 0
            n = 0

            ' limpa todos os comentarios
            rng1.ClearComments

            ' para cada celula no gantt
            For Each celula In rng1

                ' valido se a celula for vermelha (data do pagamento)
                If celula.DisplayFormat.Interior.Color = RGB(255, 0, 0) Then
                    ' If celula.Row = 4 + 3 * i Then


                    ' adiciona o comentario
                    With celula.AddComment
                        .Text Text:="data"
                    End With

                    End If
            Next celula

            End Sub

person nero1nero    schedule 04.12.2018    source источник
comment
Если значения должны быть в ячейке, почему бы не использовать поиск, а не код?   -  person Nathan_Sav    schedule 04.12.2018
comment
они должны быть в комментарии внутри ячейки! ячейка слишком мала, чтобы показать все эти значения. Понимаете? это показано на рисунке 1, маленькие красные клетки.   -  person nero1nero    schedule 04.12.2018
comment
Ах, ячейка означает что-то еще на форуме Excel :) Посмотрите на использование чего-то в этом роде внутри вашего цикла, activecell.AddComment(cstr(application.WorksheetFunction.VLookup(range("a1").Value,range("g1:h100"),2,false)))   -  person Nathan_Sav    schedule 04.12.2018
comment
я добавил код, который у меня есть до сих пор! тогда я попробую воспользоваться поиском. Спасибо чувак!   -  person nero1nero    schedule 04.12.2018
comment
Кроме того, посмотрите на использование «Найти по формату», чтобы найти только ваши красные ячейки   -  person Nathan_Sav    schedule 05.12.2018


Ответы (1)


Я это сделал! Вот код, который я использовал.

            Sub AtualizaComent()

            ' variaveis
            Dim gantt    As Range
            Dim linha    As Range
            Dim celula   As Range
            Dim data     As Range
            Dim valor    As Range
            Dim etapa    As Range
            Dim i, j, k, l, m, n As Integer

            ' inicializaçao
            Set gantt = Range("T4:APV726")
            i = 0
            j = 0
            k = 0
            l = 0
            m = 0
            n = 0

            ' limpa todos os comentarios
            gantt.ClearComments

            ' para cada linha no gantt
            For Each linha In gantt.Rows
                If linha.Row = 4 + 3 * i Then
                    ' para cada celula na linha
                    For Each celula In linha.Cells
                        ' valido se a celula for vermelha (data do pagamento)
                        If celula.DisplayFormat.Interior.Color = RGB(255, 0, 0) Then
                            ' celulas que contem as datas, valores e etapa
                            Set data = Worksheets("Operacional - Pag Estudos").Cells(4 + 3 * i, 8 + 2 * j)
                            Set valor = Worksheets("Operacional - Pag Estudos").Cells(5 + 3 * i, 8 + 2 * j)
                            Set etapa = Worksheets("Operacional - Pag Estudos").Cells(6 + 3 * i, 8 + 2 * j)
                            ' adiciona o comentário
                            With celula.AddComment
                                .Text Text:=data.Text & _
                                            Chr(10) & valor.Text & _
                                            Chr(10) & etapa.Text
                            End With
                            j = j + 1
                        End If
                    Next celula
                    i = i + 1
                    j = 0
                End If
            Next linha

            For Each linha In gantt.Rows
                If linha.Row = 5 + 3 * k Then
                    For Each celula In linha.Cells
                        If celula.DisplayFormat.Interior.Color = RGB(255, 0, 0) Then
                            Set data = Worksheets("Operacional - Pag Projetos").Cells(4 + 3 * k, 8 + 2 * l)
                            Set valor = Worksheets("Operacional - Pag Projetos").Cells(5 + 3 * k, 8 + 2 * l)
                            Set etapa = Worksheets("Operacional - Pag Projetos").Cells(6 + 3 * k, 8 + 2 * l)
                            With celula.AddComment
                                .Text Text:=data.Text & _
                                            Chr(10) & valor.Text & _
                                            Chr(10) & etapa.Text
                            End With
                            l = l + 1
                        End If
                    Next celula
                    k = k + 1
                    l = 0
                End If
            Next linha

            For Each linha In gantt.Rows
                If linha.Row = 6 + 3 * m Then
                    For Each celula In linha.Cells
                        If celula.DisplayFormat.Interior.Color = RGB(255, 0, 0) Then
                            Set data = Worksheets("Operacional - Pag Obras").Cells(4 + 3 * m, 8 + 2 * n)
                            Set valor = Worksheets("Operacional - Pag Obras").Cells(5 + 3 * m, 8 + 2 * n)
                            Set etapa = Worksheets("Operacional - Pag Obras").Cells(6 + 3 * m, 8 + 2 * n)
                            With celula.AddComment
                                .Text Text:=data.Text & _
                                            Chr(10) & valor.Text & _
                                            Chr(10) & etapa.Text
                            End With
                            n = n + 1
                        End If
                    Next celula
                    m = m + 1
                    n = 0
                End If
            Next linha

            End Sub

Спасибо @Nathan_Sav за помощь.

person nero1nero    schedule 05.12.2018