Vlookup复制单元格的颜色 - Excel VBA [英] Vlookup to copy color of a cell - Excel VBA
本文介绍了Vlookup复制单元格的颜色 - Excel VBA的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我有以下表格：
A B C D
1 Bob 1 6 Football
2 Nate 3 7 Baseball
3 Silver 3 2 Baseball
4 Box 7 1 Cycling
A D
Bob ?
Nate ?
我可以成功使用Vlookup填写？细胞。例如，Vlookup（A8，A $ 1D $ 4,4,0）。
我不知道的是让Vlookup复制颜色。应该有VBA的解决方案。我希望你的帮助。
I can successfully use Vlookup to fill the ? cells. For example, Vlookup(A8,A$1D$4,4,0).
What I don´t know is to get Vlookup to copy the color too. There should be a solution in VBA. I hope your help.
推荐答案
你去：
- 将此代码粘贴到新模块中
- 选择您要通过VLOOKUP目标格式化的单元格
- 运行宏
formatSelectionByLookup
- Paste this code into a new module
- Select the cells you'd like to format by VLOOKUP target
- Run the macro
formatSelectionByLookup
以下是代码：
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, 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
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
这篇关于Vlookup复制单元格的颜色 - Excel VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
