Всем привет.
Программирую я 3 дня чистого времени, поэтому за редким исключением код vba это тёмный лес.
Я честно стырил готовый код для выделения цветом дубликатов в выделенных ячейках и насколько мог модернизировал его.
Нужно:
чтобы выделялись цветом дубликаты только столбца 3, затем, ничего не меняя, в столбце 3, выделялись цветом дубликаты только столбца 4.
Сейчас:
если в столбце 3 уже есть значение, которое ввожу в столбец 4, то закрашивается значение в столбце 4, т.е в цикле где-то сохраняются значения с первого круга.
| Код |
|---|
On Error Resume Next
Colors = Array(12900829, 15849925, 14408946, 14610923, 15986394, 14281213, 14277081, _
9944516, 14994616, 12040422, 12379352, 15921906, 14336204, 15261367, 14281213)
Dim coll As New Collection, dupes As New Collection, _
cols As New Collection, ra As Range, cell As Range, n&
For ww = 3 To 4
Err.Clear: Set ra = Intersect(Range(Cells(2, ww), Cells(LastRow, ww)), ActiveSheet.UsedRange)
If Err Then Exit Sub
ra.Interior.ColorIndex = xlColorIndexNone:
For Each cell In ra.Cells
Err.Clear: If Len(Trim(cell)) Then coll.Add CStr(cell.Value), CStr(cell.Value)
If Err Then dupes.Add CStr(cell.Value), CStr(cell.Value)
Next cell
For i& = 1 To dupes.Count
n = n Mod (UBound(Colors) + 1): cols.Add Colors(n), dupes(i): n = n + 1
Next
For Each cell In ra.Cells
cell.Interior.color = cols(CStr(cell.Value))
Next cell
ra = Nothing
cell = Nothing
coll.Erase Arr
cols.Erase Arr
dupes.Erase Arr
n = 0
Next |
Переменная lastrow это номер последней заполненной строки + 1
На всякий случай приложил файл.
в начальной форме на экране
транзакции = добавить запись в последнюю ячейку в столбец 3.
заказ =добавить запись в последнюю ячейку в столбец 4.
