Как найти и нарисовать все равные значения таблицы с одним и тем же цветом внутренней ячейки, используя матрицу и циклы в VBA? - PullRequest
0 голосов
/ 18 апреля 2019

У меня есть таблица в Excel, которую я всегда должен заполнять новыми строками, после вставки строки мне нужно проверить, заполнено ли каждое введенное значение в какой-то предыдущей точке таблицы, если значение выходит за пределы цвета внутренней ячейкидолжны быть окрашены в соответствии с цветом предыдущих ячеек, который содержит то же значение.

Другими словами, мне нужна таблица, в которой все ячейки с одинаковыми значениями закрашены одинаковым цветом.

Итак, я создал код VBA, но по какой-то неизвестной причине в макросе есть пробел, и иногда он не рисует некоторые ячейки последней строки, которые должны быть нарисованы.Может ли кто-нибудь помочь мне, пожалуйста?

PS: количество столбцов os строк таблицы не является постоянным

Sub paint_equal_data()
    Dim table As Worksheet
    Set table = ThisWorkbook.Sheets("Plan5") 'set the plan of the table
    Dim data() As String  'set the array with the new data inserted (last row, each column of this row contains a data and will be an element of the array)
    Dim nrows As Integer 'number of rows
    Dim dataNewAmount As Integer 'the amount of data new

    nrows = table.Range("a1").CurrentRegion.Rows.Count 'set the number of rows of the table
    dataNewAmount = table.Cells(nrows, 1).CurrentRegion.Columns.Count 'the number of new data insert through the last row is numerally equal to the amount of columns of the last row

    ReDim data(dataNewAmount) 'set the  size of the array data as numerally equal to the amount new data
    Dim index As Integer 'index of th array
    For index = 1 To dataNewAmount
         data(index) = table.Cells(nrows, index).Value 'every element of the array cotains a data of the last column
    Next index
    index = 1
    Dim row_addr As Integer
    Dim column_addr As Integer
    For row_addr = (nrows - 1) To 1 Step -1   'this block reads each data of the whole table and check if it is equal to the current data(index) (a data of the new row)
         For column_addr = 1 To dataNewAmount
                 If data(index) = table.Cells(row_addr, column_addr).Value Then 'if they are equal paint them with the same color
                        If index < dataNewAmount Then
                        index = index + 1 'now the macro has found the similar data of the current element of the data() array, so it needs to find if the next data() element has also a similar data on the table
                        column_addr = 1 'the macro needs to reset its seach for equal data from the first columun of the table
                    End If
                End If
                If column_addr >= dataNewAmount And data(index) <> data(dataNewAmount) Then 'This block treats the case when the data() element couldn't be found in any cell of the table, so the macro won't paint the cell and will search the nest data() element
                    index = index + 1
                    column_addr = 1
                    Exit For
                End If
        Next column_addr
   Next
End Sub

1 Ответ

0 голосов
/ 18 апреля 2019

Использование макроса для применения условного форматирования, аналогично:

dim lr as long, lc as long
With Sheets("")
    lr = .cells(.rows.count,1).end(xlup).row
    'lc = .cells(1, .columns.count).end(xlup).row
    .Cells.FormatConditions.Delete
    With .Range("A1:O" & lr) 'applies code to the row from column A to O... can also be applied to a single column, specifying starting row and ending row
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$A1=$J1" 'used arbitrary value = value; not that the "$" placement is important so that formatting applies to a row
        With .FormatConditions(.FormatConditions.Count)
            .SetFirstPriority
            With .Interior
                .Color = RGB(0, 70, 255)  'applies a blue fill
                .TintAndShade = 0.8  'fill is 80% trasparent
            End With
        End With
    End With

Мое обоснование для предложения программирования условного форматирования заключается в том, что при управлении данными вы можете столкнуться со строками, которых не было в исходномдиапазон, или вы вставили строки и т. д., что приводит к пробелам или странному размещению форматирования.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...