问题
I've created a function that searches a specific value on a range and returns adjacent characteristics.
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
If there is no match for valor in A1:A10, the function returns {#VALUE,#VALUE}, wich is ok, but I'd like to return instead something like {"No match", ""}, with the "No match" cell in a given color. I've tried data validation, error handling and If Then with ActiveCell.Interior.ColorIndexto no avail. Also, if the error is corrected, I'd like the cell to go back to transparent.
I guess an event handler could do the trick, but I'm new at VBA and there are still a lot of things that I don't understand.
EDIT
As suggested, to be clear:
How do I make the output cell(s) to change color if no match is found, and to have no color if a match is found (in VBA)?
回答1:
This is a completely rewritten answer in the light of new information from the questioner.
If I understand correctly, you wish to create a Custom Function that will change the colour of a cell. The following text from Microsoft's Help on custom functions says you cannot:
The number of VBA keywords you can use in custom functions is smaller than the number you can use in macros. Custom functions are not allowed to do anything other than return a value to a formula in a worksheet or to an expression used in another VBA macro or function. For example, custom functions cannot resize windows, edit a formula in a cell, or change the font, color, or pattern options for the text in a cell. If you include "action" code of this kind in a function procedure, the function returns the #VALUE! error.
I know of two alternatives that might meet your requirements. A third alternative was added later after a flash of inspiration.
Alternative 1: Offer a drop down list of the permitted values
Position the cursor to a cell which is to have restricted values. Select Data from the toolbar then Validation. A Data Validation form is displayed.
Select the Settings tab if not already selected. Click the box under "Allow:" and select List. In the Source box enter: "=$A$1:$A$10". (The "=" is required. The $s are important if you want to be able to create copies of this cell.) Click OK.
When the user positions the cursor to that cell they can either enter a permitted value or can select a permitted value from the list. An attempt to enter any other value will result in an error message. The other tabs within the Data Validation form allow you to enter a help message and your own error message.
Because of the $s in the source box, you can copy the original cell and its validation to other cells.
Alternative 2: Conditional formatting
If the permitted values are a range, conditional formatting will meet your requirements. For example suppose the permitted range is 10 to 20.
Select Format from the toolbar then Conditional Formatting.
Boxes for condition 1 are displayed. "Between" is already displayed. In the boxes to the right enter 10 and 20.
Click Add to display boxes for condition 2. Replace Between" by "Less than". In the next box enter 10. Click Format. Click Colour. Select Red. Click OK.
Click Add to display boxes for condition 3. Replace Between" by "Greater than". In the next box enter 20. Click Format. Click Colour. Select Red. Click OK.
Click OK to accept the conditional formatting.
The user can enter anything they like into the cell but it will be red unless it is between 10 and 20.
You can create as many copies of the formatted cell as you wish.
Worksheet change event
I should have thought of events before. I believe this does exactly what you want.
Within the VBA Editor, the Project Explorer is normally visible on the left of the screen. If it is not, Click Ctrl+R.
Right click the line for the worksheet within which selected values are to be controlled. Click View Code.
The code area will be headed Worksheet but will otherwise be blank. You can place various routines in this area but the relevant routines are the worksheet event routines. These are routines that will be called whenever an event such as worksheet activated or deactivated occurs. The event you want is Change which is called whenever the user changes a cell. The attraction of this routine is that it can do anything you want.
Copy and Paste the Worksheet_Change routine below into the worksheet code area.
Its parameter is the address of the cell that the user has changed.
TgtRngList is set to a list of the ranges you wish to patrol. I have set this to C1:C1000, F1:F1000 and A1. You will have to change this to the ranges you want to patrol.
OKValueList is set to a list of the permitted values for the patrolled ranges. They could be in a sheet somewhere but I think it is easier to define them here. Change the list to whatever you want.
The code checks for the changed cell being in one of the patrolled area. If it is, it is checked to have a permitted value. The result of that check causes the cell to be set to black or red.
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
Hope this helps.
回答2:
I am not sure where you are going with offset appended to xlWhole, which refers to whether or not to check the whole cell. Here are some notes, you will see that find returns an object:
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
来源：https://stackoverflow.com/questions/8511073/vba-format-cell-on-value-error