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

來源

2014-12-06 Jeff Thompson

請註明您就顯示什麼錯誤，而不是隻把樣本文件。 – 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

來源

2014-12-10 19:25:59 Tragamor

VLOOKUP複製單元格的顏色 - 錯誤的格式返回

回答

相關問題