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

excel vba excel-vba cell-formatting

4790 просмотра

1 ответ

112 Репутация автора

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

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

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

Cells(X, Y).ClearFormats

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

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


  • A1: J10 напечатает новый цвет
  • К1 напечатает процент до завершения
  • 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
    
Автор: MrMusAddict Источник Размещён: 18.07.2016 11:59

Ответы (1)


3 плюса

3386 Репутация автора

Есть несколько способов решить эту проблему, но самый простой и простой способ - удалить все лишние стили (я видел книги со стилями 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
Автор: asher Размещён: 20.07.2016 07:03
Вопросы из категории :
32x32