☰

将一列中所有突出显示的日期与另一列中的日期进行匹配

tag-icon • tag-icon microsoft-excel worksheet-function microsoft-excel-2010 vba microsoft-excel-2007
将一列中所有突出显示的日期与另一列中的日期进行匹配

我目前停滞在项目的这一步。我的文档图片 我的最终目标是在 M 列中突出显示 P 列中的所有突出显示的日期。我想知道是否存在一个公式，以便我可以仅从 P 列中选择所有突出显示的值并在 M 列中突出显示相同的值。

因此，我在一列中列出了一堆突出显示的日期，参见 P 列。我找不到将突出显示的日期复制到 M 列的方法，因此我不得不手动复制，这导致了 N 列的形成，因为我希望有一个公式可以突出显示 N 列和 M 列中所有相同的值。我仍然找不到合适的公式来做到这一点。

由于有多个文档，因此手动操作会非常耗时。提前谢谢您，任何帮助都将不胜感激！

答案1

这是一个您可以尝试的宏解决方案...

  1. 我们取 Sheet1 中使用范围和 P 列的交叉范围
  2. 对于 M 列也是如此，它返回相同的行范围。
  3. 对于 M 列中的每个单元格，使用该MATCH函数检查 P 列中是否存在该值

  4. 如果找到匹配项，则复制 P 列中匹配单元格的字体和背景颜色，并将其应用于 M 列中的“搜索”单元格

    Sub LookupHiglight()
'
' LookupHiglight Macro
'

'
    Dim ws As Worksheet
    Dim rngP, rngM, matchCellP As Range
    Dim cellM As Range
    Dim rowIndex_P As Variant

    Set ws = Worksheets("Sheet1")

    Set rngP = Intersect(ws.UsedRange, ws.Range("P:P"))
    Set rngM = Intersect(ws.UsedRange, ws.Range("M:M"))

    If rngP Is Nothing Then
        MsgBox "No intersection found with the target column - P:P. Exiting"
        Exit Sub
    End If

    For Each cellM In rngM

        On Local Error Resume Next

        rowIndex_P = Application.Match(cellM, rngP, 0)

        If Not IsError(rowIndex_P) Then

            Set matchCellP = Range("P" & rowIndex_P)
            cellM.Font.color = matchCellP.Font.color
            cellM.Interior.color = matchCellP.Interior.color

        End If

    Next

    MsgBox "Done"

End Sub

希望这可以帮助。

答案2

P 列中突出显示日期的条件是什么，或者您如何选择要突出显示的日期？如果这是条件格式 - 那么您可以将相同的条件格式应用于 M 列。如果是手动选择 - 您需要使用 VBA 代码，它将执行类似以下操作：1. 循环遍历 P 列 2. 创建突出显示日期的数组 3. 循环遍历 M 列并检查每个单元格是否与创建的数组匹配。如果是 - 突出显示单元格

查看代码示例

Sub Sub1()
Dim RngToCheck As Range, rngToUpdate As Range, Cell As Range
Dim CheckColor As Single
Dim MyDates() As Date
Dim Counter As Integer

CheckColor = RGB(198, 239, 206)  '' edit the color as required - it should be the color of highlihgted cells as Red, Green, Blue from format

Set RngToCheck = ActiveSheet.Range("P8:P24")  ''' make sure the address of range to check is correct
Set rngToUpdate = ActiveSheet.Range("M8:M24") ''' make sure the address of range to update is correct

''' this loop goes through cells P and create an array of highilted dates
For Each Cell In RngToCheck.Cells
    If Cell.Interior.Color = CheckColor Then
        Counter = Counter + 1
        ReDim Preserve MyDates(1 To Counter)
        MyDates(Counter) = Cell.Value
    End If
Next Cell

''' this loop goes through cells in column M and highiltes same dates as highlighted in column P
For Each Cell In rngToUpdate.Cells
    For Counter = LBound(MyDates) To UBound(MyDates)
        If Cell.Value = MyDates(Counter) Then Cell.Interior.Color = CheckColor
    Next Counter
Next Cell


End Sub

相关内容