Question

我正在使用宏@LondonRob发布in this SO question

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

Answer 1

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

另外 - 要正确复制'no fill'单元格，请将copyFormatting 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

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

1 个答案: