Question

我创建了一个函数，用于搜索范围上的特定值并返回相邻的特征。

Function Busca(valor As String)
    Dim bus(0 To 1)
    bus(0) = Worksheets("Sheet2").Range("A1:A10").Find(valor, LookAt:=xlWhole). _
        Offset(0, 1)
    bus(1) = Worksheets("Sheet2").Range("A1:A10").Find(valor, LookAt:=xlWhole). _
        Offset(0, 2)
    Busca = bus
End Function

如果valor中的A1:A10不匹配，则该函数会返回{#VALUE,#VALUE}，这是好的，但我想返回{"No match", ""}之类的内容，与给定颜色的“不匹配”单元格。我已尝试使用If进行数据验证，错误处理和Then ActiveCell.Interior.ColorIndex无效。此外，如果纠正错误，我希望单元格恢复透明。

我想一个事件处理程序可以做到这一点，但我是VBA的新手，还有很多我不理解的事情。

修改

正如所建议的那样，要明确：

如果找不到匹配项，如何使输出单元格改变颜色，如果找到匹配项，如何没有颜色（在VBA中）？

Answer 1

根据提问者提供的新信息，这是一个完全重写的答案。

如果我理解正确，您希望创建一个可以更改单元格颜色的自定义函数。 Microsoft关于自定义函数的帮助中的以下文本说您不能：

您可以在自定义函数中使用的VBA关键字数量较少比你可以在宏中使用的数字。自定义功能不是除了将值返回到a中的公式之外，还允许执行任何操作工作表或另一个VBA宏或函数中使用的表达式。例如，自定义函数无法调整窗口大小，编辑公式单元格，或更改文本中的字体，颜色或图案选项一个细胞。如果在函数中包含此类“动作”代码过程，函数返回#VALUE！错误。

我知道两种可能符合您要求的替代方案。第二种选择是在灵感闪现之后加入的。

备选方案1：提供允许值的下拉列表

将光标定位到具有受限值的单元格。从工具栏中选择数据，然后选择验证。将显示“数据验证”表单。

如果尚未选择，请选择“设置”选项卡。单击“允许：”下的框，然后选择“列表”。在“来源”框中输入：“= $ A $ 1：$ A $ 10”。（“=”是必需的。如果您希望能够创建此单元格的副本，则$ s很重要。）单击“确定”。

当用户将光标定位到该单元格时，他们可以输入允许值，也可以从列表中选择允许值。尝试输入任何其他值将导致错误消息。数据验证表单中的其他选项卡允许您输入帮助消息和您自己的错误消息。

由于源框中的$ s，您可以将原始单元格及其验证复制到其他单元格。

备选方案2：条件格式

如果允许的值是范围，则条件格式将满足您的要求。例如，假设允许的范围是10到20。

从工具栏中选择格式，然后选择条件格式。

显示条件1的框。已经显示“之间”。在右边的框中输入10和20。

单击“添加”以显示条件2的框。在“by”小于“之间替换。在下一个框中输入10.单击”格式“。单击”颜色“。选择”红色“。单击”确定“。

单击“添加”以显示条件3的框。在“by”之间替换大于“。在下一个框中输入20.单击”格式“。单击”颜色“。选择”红色“。单击”确定“。

单击“确定”接受条件格式。

用户可以将任何他们喜欢的东西输入到单元格中，但除非介于10和20之间，否则它将为红色。

您可以根据需要创建任意数量的格式化单元格。

工作表更改事件

我之前应该考虑过事件。我相信这正是你想要的。

在VBA编辑器中，Project Explorer通常显示在屏幕左侧。如果不是，请点击Ctrl+R。

右键单击要控制所选值的工作表行。点击View Code。

代码区域将以工作表为标题，否则将为空白。您可以在此区域中放置各种例程，但相关例程是工作表事件例程。这些是在激活或停用工作表等事件时将调用的例程。您想要的事件是每当用户更改单元格时调用的更改。这个例程的吸引力在于它可以做任何你想做的事情。

将下面的Worksheet_Change例程复制并粘贴到工作表代码区域中。

其参数是用户已更改的单元格的地址。

TgtRngList设置为您要巡逻的范围列表。我把它设置为C1：C1000，F1：F1000和A1。您必须将其更改为您要巡逻的范围。

OKValueList设置为巡逻范围的允许值列表。它们可能在某个地方，但我认为在这里定义它们更容易。将列表更改为您想要的任何内容。

代码检查已更改的单元位于其中一个巡逻区域。如果是，则检查是否具有允许值。该检查的结果导致单元格设置为黑色或红色。

Option Explicit
Sub Worksheet_Change(ByVal ChangedCell As Range)

  ' This routine is called whenever the user changes a cell.
  ' It is not called if a cell is changed by Calculate

  Dim ColChanged As Integer
  Dim InxOV As Integer
  Dim InxTR As Integer
  Dim OKValueList() As Variant
  Dim Patrolled As Boolean
  Dim RowChanged As Integer
  Dim TgtColLeft As Integer
  Dim TgtColRight As Integer
  Dim TgtRngPartList() As String
  Dim TgtRngList() As Variant
  Dim TgtRngPart As String
  Dim TgtRowBottom As Integer
  Dim TgtRowTop As Integer
  Dim ValueChanged As String
  Dim ValueOK As Boolean

  ' Fill TgtRngList withe ranges that are to be patrolled by this routine
  TgtRngList = Array("C1:C1000", "F1:F1000", "A1")

  ' Fill OKValueList with the permitted values for these cells.
  OKValueList = Array("V1", "V2", "V3", "V4", "V5", _
                      "V6", "V7", "V8", "V9", "V10")

  ColChanged = ChangedCell.Column
  RowChanged = ChangedCell.Row

  Patrolled = False
  For InxTR = LBound(TgtRngList) To UBound(TgtRngList)
    TgtRngPartList = Split(TgtRngList(InxTR), ":")
    ' Decode top left of range
    TgtRngPart = TgtRngPartList(LBound(TgtRngPartList))
    TgtRowTop = Range(TgtRngPart).Row
    TgtColLeft = Range(TgtRngPart).Column
    If LBound(TgtRngPartList) = UBound(TgtRngPartList) Then
      ' There is no colon so single cell range
      TgtRowBottom = TgtRowTop
      TgtColRight = TgtColLeft
    Else
      TgtRngPart = TgtRngPartList(UBound(TgtRngPartList))
      TgtRowBottom = Range(TgtRngPart).Row
      TgtColRight = Range(TgtRngPart).Column
    End If
    If RowChanged >= TgtRowTop And RowChanged <= TgtRowBottom And _
       ColChanged >= TgtColLeft And ColChanged <= TgtColRight Then
      ' This is a patrolled cell
      Patrolled = True
      Exit For
    End If
  Next
  If Patrolled Then
    With ActiveSheet
      ValueChanged = .Cells(RowChanged, ColChanged).Value
      ' Check value against permitted list
      ValueOK = False
      For InxOV = LBound(OKValueList) To UBound(OKValueList)
        If ValueChanged = OKValueList(InxOV) Then
          ValueOK = True
          Exit For
        End If
      Next
      If ValueOK Then
        ' Set cell black
        .Cells(RowChanged, ColChanged).Font.Color = RGB(0, 0, 0)
      Else
        ' Set cell red
        .Cells(RowChanged, ColChanged).Font.Color = RGB(255, 0, 0)
      End If
    End With
  End If

End Sub

希望这会有所帮助。

Answer 2

我不知道你在哪里使用附加到xlWhole的偏移量，它指的是是否要检查整个单元格。以下是一些注释，您将看到find返回一个对象：

Function Busca(valor As String)
''http://msdn.microsoft.com/en-us/library/aa195730(v=office.11).aspx
Dim bus(0 To 1)
With Worksheets("Sheet2").Range("A1:A10")
    Set c = .Find(valor, LookAt:=xlWhole)
    If Not c Is Nothing Then
        bus(0) = c.Address

        Set c = .FindNext(c)
        If Not c Is Nothing Then
            bus(1) = c.Address
        Else
            bus(1) = "None"
        End If
    Else
        bus(0) = "None"
    End If
End With
Debug.Print bus(0), bus(1)
Busca = bus
End Function

VBA：#VALUE错误上的格式化单元格

2 个答案: