web-dev-qa-db-ja.com

ある列で強調表示されているすべての日付を別の列の日付と一致させる

私は現在、プロジェクトのこのステップで立ち往生しています。 マイドキュメントの画像私の最終的な目的は、列Mの列Pで強調表示されているすべての日付を強調表示することです。そこにあるかどうか疑問に思いましたは、列Pからのみ強調表示されたすべての値を選択し、列Mで同じ値を強調表示できるようにするための数式でした。

したがって、1つの列に多数の強調表示された日付があります。列Pを参照してください。強調表示された日付を列Mにコピーする方法が見つからなかったため、手動でコピーする必要があり、列Nが形成されました。 N列とM列のすべての同じ値を強調表示する数式があることを望みました。それでも、そうするための適切な数式を見つけることができませんでした。

複数のドキュメントがあるため、すべて手作業で行うのは非常に時間がかかります。よろしくお願いします。どんな助けでも大歓迎です！

microsoft-excelworksheet-functionmicrosoft-excel-2010vbamicrosoft-excel-2007
2
Sirmike

これがあなたが試すことができるマクロソリューションです...

  1. Sheet1の使用範囲と列Pの交差する範囲を取得します
  2. 同じ行範囲を返す列Mについても同じことが言えます。
  3. 列Mの各セルについて、MATCHfunctionを使用して、値が列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
Karthick Ganesan

列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
1
Yury Suturin