Excel 单元格颜色按内容中的 AutoCAD 颜色

Question

我希望的输出类似于此页面：http://sub-atomic.com/~moses/acadcolors.html，但在 Excel 中。

我们正在尝试将 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

Answer 1

使用 alt+f11 打开编辑器，将此代码放入 Sheet1：

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

它将检查从 Cell(1,1) 到 Cell(1000,1000) 的用户输入，然后它从 Sheet2 中获取颜色，我将您链接的 autocad 表放在其中（复制并粘贴表）：