Vlookup复制单元格的颜色 – Excel VBA

我有以下表格：

ABCD 1 Bob 1 6 Football 2 Nate 3 7 Baseball 3 Silver 3 2 Baseball 4 Box 7 1 Cycling AD Bob ? Nate ? 

我可以成功使用Vlookup来填补? 细胞。 例如，Vlookup（A8，$ 1D $ 4,4,0）。 我不知道的是让Vlookup也复制颜色。 VBA中应该有一个解决scheme。 我希望你的帮助。

Answer 1

干得好：

1. 将这个代码粘贴到一个新的模块中
2. select您想要通过VLOOKUP目标进行格式化的单元格
3. 运行macrosformatSelectionByLookup

代码如下：

 Option Explicit ' By StackOverflow user LondonRob ' See http://stackoverflow.com/questions/22151426/vlookup-to-copy-color-of-a-cell-excel-vba Public Sub formatSelectionByLookup() ' Select the range you'd like to format then ' run this macro copyLookupFormatting Selection End Sub 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, eg 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 Private Function extractDestRange(fromCell As Range) As Range ' Get the destination range of a vlookup in the formulat ' of fromCell. Returns fromCell itself if no vlookup is ' detected. Dim fromFormula As String Dim startPos As Integer Dim endPos As Integer Dim destAddr As String fromFormula = fromCell.Formula If Left(fromFormula, 9) = "=VLOOKUP(" Then startPos = InStr(fromFormula, ",") + 1 endPos = InStr(startPos, fromFormula, ",") destAddr = Trim(Mid(fromFormula, startPos, endPos - startPos)) Else destAddr = fromCell.Address End If Set extractDestRange = fromCell.Parent.Range(destAddr) End Function Private Function extractLookupColNum(fromCell As Range) As Integer ' If fromCell contains a vlookup, return the number of the ' column requested by the vlookup. Otherwise return 1 Dim fromFormula As String Dim startPos As Integer Dim endPos As Integer Dim colNumber As String fromFormula = fromCell.Formula If Left(fromFormula, 9) = "=VLOOKUP(" Then startPos = InStr(InStr(fromFormula, ",") + 1, fromFormula, ",") + 1 endPos = InStr(startPos, fromFormula, ",") If endPos < startPos Then endPos = InStr(startPos, fromFormula, ")") End If colNumber = Trim(Mid(fromFormula, startPos, endPos - startPos)) Else colNumber = 1 End If extractLookupColNum = colNumber End Function Private Function getNthColumn(fromRange As Range, n As Integer) As Range ' Get the Nth column from fromRange Dim startCell As Range Dim endCell As Range Set startCell = fromRange(1).Offset(0, n - 1) Set endCell = startCell.End(xlDown) Set getNthColumn = Range(startCell, endCell) End Function