Блог

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

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

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

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

 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
  

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

 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" amp; 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
  

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