问题描述
我使用宏@LondonRob发布了
I'm using the macro @LondonRob posted in this SO question
我有一个问题，如果一个值重复，它会拉出原始事件的颜色，而不是实际看增值。所以如果Item1持有C列为1.27的字体颜色为粉红色，而item4的C列为1.27，字体颜色为蓝色，则当我在vlookup item4的1.27上运行宏时，将会变成粉色而不是蓝色。
I'm having an issue that if a value repeats, it pulls the color of the original incident rather than the actual looked up value. So if Item1 holds a value in column C of 1.27 and font color pink, and item4 holds a value in column C of 1.27 and font color blue, when I run the macro on the vlookup item4's 1.27 it will be colored pink rather than blue.
代码的关键位在这里：
Private Sub copyLookupFormatting(destRange As Range)
' Take each cell in destRange and copy the formatting
' from the destination cell (either itself or
' the vlookup target if the cell is a vlookup)
Dim destCell As Range
Dim srcCell As Range
For Each destCell In destRange
Set srcCell = getDestCell(destCell)
copyFormatting destCell, srcCell
Next destCell
End Sub
Private Sub copyFormatting(destCell As Range, srcCell As Range)
' Copy the formatting of srcCell into destCell
' This can be extended to include, e.g. borders
destCell.Font.Color = srcCell.Font.Color
destCell.Font.Bold = srcCell.Font.Bold
destCell.Font.Size = srcCell.Font.Size
destCell.Interior.Color = srcCell.Interior.Color
End Sub
Private Function getDestCell(fromCell As Range) As Range
' If fromCell is a vlookup, return the cell
' pointed at by the vlookup. Otherwise return the
' cell itself.
Dim srcColNum As Integer
Dim srcRowNum As Integer
Dim srcRange As Range
Dim srcCol As Range
srcColNum = extractLookupColNum(fromCell)
Set srcRange = extractDestRange(fromCell)
Set srcCol = getNthColumn(srcRange, srcColNum)
srcRowNum = Application.Match(fromCell.Value, srcCol, 0)
Set getDestCell = srcRange.Cells(srcRowNum, srcColNum)
End Function
推荐答案
p>问题是Application.Match在第一个实例中停止任何非唯一值。您应该使用具有唯一值的列进行搜索。
The problem is with Application.Match which stops at the first instance of any non-unique values. You should use a column with unique values to search against.
如果您将其用于vlookup，则第一列应该是唯一的，因此请尝试用以下替换getDestCell函数：
The first column should be unique if you're using it for a vlookup so try replacing the getDestCell function with:
Private Function getDestCell(fromCell As Range) As Range
' If fromCell is a vlookup, return the cell
' pointed at by the vlookup.
' Otherwise return the cell itself.
Set getDestCell = fromCell
Dim VLUData() As String
Dim srcRow As Double, srcCol As Double
Dim VLUTable As Range
If Left(fromCell.Formula, 9) = "=VLOOKUP(" Then
VLUData() = Split(Mid(fromCell.Formula, 10, _
Len(fromCell.Formula) - 10), ",")
Set VLUTable = Range(VLUData(1))
srcRow = Application.WorksheetFunction.Match _
(Range(VLUData(0)).Value, VLUTable.Columns(1), 0)
srcCol = VLUTable.Columns(Val(VLUData(2))).Column
Set getDestCell = Cells(srcRow, srcCol)
End If
End Function
支持函数extractLookupColNum，extractDestRange和getNthColumn也可以作为数组VLUData被删除，并使用VLookup参数进行填充，如果需要，可直接在函数中进行唯一匹配。
The support functions extractLookupColNum, extractDestRange and getNthColumn can also be deleted as the array VLUData is filled with the VLookup arguments and can be manipulated directly in the function for unique matching if further necessary.
另外 - 允许复制'no fi '''单元格正确编辑copyFormatting Sub到：
Also - to allow copying of 'no fill' cells correctly, edit the copyFormatting Sub to:
Private Sub copyFormatting(destCell As Range, srcCell As Range)
' Copy the formatting of srcCell into destCell
' This can be extended to include, e.g. borders
destCell.Font.Color = srcCell.Font.Color
destCell.Font.Bold = srcCell.Font.Bold
destCell.Font.Size = srcCell.Font.Size
If destCell.Address <> srcCell.Address Then _
destCell.Interior.Color = srcCell.Interior.Color
If srcCell.Interior.ColorIndex = xlNone Then _
destCell.Interior.ColorIndex = xlNone
End Sub
这篇关于vlookup复制单元格的颜色 - 返回错误的格式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！