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

我正在使用宏@LondonRob post

我有一个问题，如果一个值重复出现，它会提取原始事件的颜色，而不是实际查找的值。因此，如果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

---

问题在于Application.Match，它在任何非唯一值的第一个实例处停止。应使用具有唯一值的列进行搜索

如果要将第一列用于vlookup，则第一列应该是唯一的，因此请尝试将getDestCell函数替换为：

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参数，如果需要，可以在函数中直接操作以进行唯一匹配

另外-要允许正确复制“无填充”单元格，请将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

---

请指定显示的错误，而不仅仅是一个示例文件。请将错误复制到问题中，以供将来参考。同时显示到目前为止您尝试的代码。