2

そこで、考えられるすべての組み合わせを使用するまで R、G、B の値をランダムに選択し (繰り返しをスキップして)、新しい色ごとに 10x10 の正方形の色値を設定する、楽しくてシンプルなマクロを作成しました。

唯一の問題は、セル形式の数が制限に達したことです。Microsoft によると、制限は 64000 前後である必要がありますが、Excel 2013 の空白のブックでは正確に 65429 であることがわかりました。

明確なフォーマットコードを含めましたが、効果がないようです:

Cells(X, Y).ClearFormats

マイクロソフトはいくつかの解決策を挙げていますが、4つのうち3つは本質的に「フォーマットを作りすぎないこと」であり、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
4

1 に答える 1

3

この問題を解決するにはいくつかの方法がありますが、最もクリーンで簡単な方法は余分なスタイルをすべて削除することです (私は 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
于 2016-07-20T07:03:49.147 に答える