2017-05-09 9 views
0

出力これは似たようなページです:http://sub-atomic.com/~moses/acadcolors.htmlしかし、Excelでは。Excelのセルの色(AutoCADの色で表示)

私たちがやっていることは、AutoCADの色をセルに結びつけることです。私はセルに色番号を入力することができます(赤色の色10)。その色にセルが変更されます。マクロを使わずにこれを行う方法はわかりません。私はそれがある種のVBAになるだろうと仮定します。

私は上記のサイトのRGB相当物を持っています - 私はあるタイプのルックアップを引き出すことができると仮定します。

これは条件付き書式の特に厄介なビットで行うことができますが、私は実際にもう少し合理化されたものを好むでしょう。

ヘルプ?

編集: UGPは、私が必要としていたような、本当に良いコードを提供してくれました。これは私が最後に使ったコードです(シートの命名と少しの追加機能を使って調整しました)。

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 
    Set KeyCells = Range(Cells(1, 6), Cells(1000, 6)) 

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
    Is Nothing Then 

    CellChanged = Target.Address 'Cell that changed 
    If IsNumeric(Worksheets("Master").Range(CellChanged).Value) Then 
     If Worksheets("Master").Range(CellChanged).Value = 0 Then 
     Worksheets("Master").Range(CellChanged).Interior.ColorIndex = xlNone 
     Worksheets("Master").Range(CellChanged).Font.Color = vbBlack 
     Else 
     Worksheets("Master").Range(CellChanged).Interior.Color = 
     Color(Worksheets("Master").Range(CellChanged).Value) 
     Worksheets("Master").Range(CellChanged).Font.Color = 
     textColor(Worksheets("Master").Range(CellChanged).Value) 
     End If 
    End If 

    End If 
End Sub 

Function Color(ByRef ID As Integer) As Long 
    Dim R, G, B As Integer 
    For i = 3 To 257 
    If ID = Worksheets("Colors").Cells(i, 1).Value Then 
     R = Worksheets("Colors").Cells(i, 2).Value 
     G = Worksheets("Colors").Cells(i, 3).Value 
     B = Worksheets("Colors").Cells(i, 4).Value 
     Color = RGB(R, G, B) 
     Exit For 
    End If 
    Next i 
End Function 

Function textColor(ByRef ID As Integer) As Long 
    If ID <= 9 Then 
    textColor = vbBlack 
    Else 
    If ID Mod 10 >= 4 Then 
     textColor = vbWhite 
    Else 
     textColor = vbBlack 
    End If 
    End If 
End Function 

答えて

0

Alt + F11でエディタを開くことで、シート1に、このコードを配置:

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 

    Set KeyCells = Range(Cells(1, 1), Cells(1000, 1000)) 

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
      Is Nothing Then 

     CellChanged = Target.Address 'Cell that changed 
     If IsNumeric(Worksheets("Sheet1").Range(CellChanged).Value) Then 
     Worksheets("Sheet1").Range(CellChanged).Interior.Color = Color(Worksheets("Sheet1").Range(CellChanged).Value) 
     End If 
    End If 
End Sub 

Function Color(ByRef ID As Integer) As Long 
Dim R, G, B As Integer 
    For i = 2 To 256 
     If ID = Worksheets("Sheet2").Cells(i, 4).Value Then 
      R = Worksheets("Sheet2").Cells(i, 5).Value 
      G = Worksheets("Sheet2").Cells(i, 6).Value 
      B = Worksheets("Sheet2").Cells(i, 7).Value 
      Color = RGB(R, G, B) 
      Exit For 
     End If 
    Next i 
End Function 

それは、セルにセル(1,1)からのユーザ入力のための(1000,1000)をチェックしますそれは、(表をコピーして貼り付け)私はあなたがこのようにリンクされAutoCADのテーブルを置くのSheet2から色をグラブ:

enter image description here

+0

ありがとう!これは非常に役に立ちました。テキストの色も扱うためにいくつかのセクションを追加しましたが、これは意図した通りに正確に機能しました。空のセルにもわずかなバグがありました。単純に/それで黒くならないようにしました。 –

+0

あなたは編集を提案して、変更がすべての人に見えるようにすることができますか?ありがとう! – UGP

+0

これはおそらく良い呼び出しです。このサイトでこれを行うには、どのような方法がありますか? –

関連する問題