Question

我通过Google找到了此代码，并且我试图让它为我工作。 Vlookup to copy color of a cell - Excel VBA

我有一个Excel工作簿，我希望在前一周我做的Excel工作表中轻松VLOOKUP值和格式化。

我可以从我们的数据库下载定价列表。然后在单元格中手动添加从/到价格。这种情况每周都会发生我必须每周手动复制粘贴，因为VLOOKUP没有添加格式。

这是源（oud）看起来：

我的VLOOKUP正确返回值，我只想要格式化。

=VLOOKUP(A2;oud!A:D;4;FALSE)

我无法在链接上获得前面提到的宏工作。我对VBA来说相当新，所以请把我当作新人;）

有人可以帮忙吗？每周都会节省我很多时间：）

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的净价栏的范围。然后我按下按钮并得到导致：

的错误

Set extractDestRange = fromCell.Parent.Range(destAddr)

运行时错误＆＃39; 1004＆＃39;：应用程序定义或对象定义错误

Excel格式vlookup与格式

0 个答案: