VLOOKUP复制单元格的颜色 - 错误的格式返回

问题描述：

我用宏@LondonRob发布in this SO question VLOOKUP复制单元格的颜色 - 错误的格式返回

我有一个问题，如果一个值重复，它拉的原始事件的颜色，而不是实际查找的值。因此，如果Item1在C列1.27中保留一个值，并且字体颜色为粉红色，并且item4在列C中保存的值为1.27，并且字体颜色为蓝色，那么当我在vlookup item4的1.27上运行宏时，它将变成粉色而不是蓝色。

代码的键位是在这里：

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

请注明您就显示什么错误，而不是只把样本文件。 – Tony 2014-12-06 14:35:49

请将错误复制到您的问题中，以备将来参考。同时显示你到目前为止所尝试的代码。 – 2014-12-06 14:35:59

答

问题是与Application.Match这在任何非唯一值的第一个实例停止。您应该使用具有唯一值的列进行搜索。

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所以尝试更换getDestCell功能的第一列应该是唯一的充满了VLookup参数，并且如果进一步需要，可以直接在函数中进行操作以进行唯一匹配。

而且 - 允许“无填充”细胞的复制正确，编辑copyFormatting子来：

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复制单元格的颜色 - 错误的格式返回

相关推荐