Excel VBA: слишком много разных форматов ячеек. Есть ли способ удалить или очистить эти форматы в макросе?

Итак, я сделал забавный и простой макрос, который случайным образом выбирает значения R, G и B, пока не использует все возможные комбинации (пропуская повторы), и устанавливает значения цвета квадрата 10x10 для каждого нового цвета.

Единственная проблема в том, что я уперся в лимит на количество форматов ячеек. Майкрософт говорит, что предел должен быть около 64000, но я обнаружил, что это точно 65429 в пустой книге Excel 2013.

Я включил код четкого формата, но, похоже, он не имеет никакого эффекта:

Cells(X, Y).ClearFormats

Microsoft перечисляет некоторые разрешения, но 3 из 4 из них, по сути, «Не делайте слишком много форматов», а 4-й формат — использование стороннего приложения.

Неужели в VBA ничего нельзя сделать?

  • A1: J10 напечатает новый цвет
  • K1 напечатает процент завершения
  • L1 напечатает количество используемых цветов

  • M1 напечатает количество повторений комбинации цветов.

    Dim CA(255, 255, 255) As Integer
Dim CC As Long
Dim RC As Long
Dim R As Integer
Dim G As Integer
Dim B As Integer
Dim X As Integer
Dim Y As Integer

CC = 0
RC = 0

X = 1
Y = 1

Do While ColorCount < 16777216
    R = ((Rnd * 256) - 0.5)
    G = ((Rnd * 256) - 0.5)
    B = ((Rnd * 256) - 0.5)

    If CA(R, G, B) <> 1 Then
        CA(R, G, B) = 1

        'Step down to the next row
        'If at the 10th row, jump back to the first and move to the next column
        If X < 10 Then
            X = X + 1
        Else
            X = 1
            If Y < 10 Then
                Y = Y + 1
            Else
                Y = 1
            End If
        End If

        Cells(X, Y).ClearFormats 'doesn't do what I hope :(
        Cells(X, Y).Interior.Color = RGB(R, G, B)
        CC = CC + 1
        Cells(1, 11).Value = (CC / 16777216) * 100
        Cells(1, 12).Value = CC
    Else
        RC = RC + 1
        Cells(1, 13).Value = RC
    End If

Loop

excel vba cell-formatting
person MrMusAddict    schedule 18.07.2016    source источник
comment
На самом деле я бы не сказал, каково решение этой проблемы. Но где вы обновляете ColorCount?   -  person user3598756    schedule 19.07.2016
comment
Массив цветов (CA) содержит элементы размером 256x256x256. Если CA(R, G, B) не установлен в 1, то установите его в 1 (чтобы он считался использованным). Затем я устанавливаю цвет фона ячейки немного ниже: Cells(X, Y).Interior.Color = RGB(R, G, B)   -  person MrMusAddict    schedule 21.07.2016

Ответы (1)


arrow_upward
3
arrow_downward

Есть несколько способов решить эту проблему, но самый чистый и простой способ — удалить все лишние стили (я видел рабочие книги с более чем 9000 стилей).

С помощью следующего простого кода VBA вы можете удалить все не встроенные стили, и в подавляющем большинстве случаев это устраняет ошибку.

Sub removeStyles() 
Dim li as long 
On Error Resume Next 

With ActiveWorkbook 
For li = .Styles.Count To 1 Step -1 
If Not .Styles(li).BuiltIn Then 
.Styles(li).Delete 
End If 
Next 
End With 
End Sub
person ASH    schedule 20.07.2016