0

Excel マクロ VBA は初めてなので、ご容赦ください。

次のように設定されたExcelファイルがあります。

Col1    Col2
----    ----
a       a
b       c
c       e
d       g
e       i
f
g
h
i
j

Col2に存在する値を検索する VBA マクロ関数を作成したいと考えています。Col1見つかった場合は、そのセルのフォントの色を赤に設定しCol1ます。

したがって、上記の例のデータでは、 、 、 、 の値aがc色eにg変わるはずiですCol1。red

Col1上記の例では、値が fromA3:A13であり、Col2from B3:B13..であるとしましょう。

エクセル2010を使用しています...

Excel VBAマクロでこれを達成するにはどうすればよいですか?

4

4 に答える 4

0

@matzoneはすでに正確な答えを出していましたが、これで自分のスキルを少しテストしたかったのです。Rangeオブジェクトと.Find()メソッドを使用して、まったく同じことを行うこの Sub を作成しました。コメントで...

Private Sub Test()
    FindAndColorMatchesOfTwoColumns "A", "B"
End Sub

Private Sub FindAndColorMatchesOfTwoColumns(colTarget As String, colList As String)
    Dim rLookUp As Range        ' Column range for list compared against
    Dim rSearchList As Range    ' Column range for compare items
    Dim rMatch As Range
    Dim sAddress As String

    ' Set compared against list from colTarget column
    Set rLookUp = Range(colTarget & "1:" & _
                  colTarget & Range(colTarget & "1").End(xlDown).Row)

    ' Loop trough list from colList column
    For Each rSearchList In Range(colList & "1:" & colList & Range(colList & "1").End(xlDown).Row)

        ' Find for a match
        Set rMatch = rLookUp.Find(rSearchList.Value, LookAt:=xlWhole)
        If Not rMatch Is Nothing Then
            ' Store first address found
            sAddress = rMatch.Address

            ' Loop trough all matches using .FindNext,
            '   exit if found nothing or address is first found
            Do
                ' Set the color
                rMatch.Font.Color = vbRed

                Set rMatch = rLookUp.FindNext(rMatch)

            Loop While Not rMatch Is Nothing And rMatch.Address <> sAddress
        End If
    Next

    Set rMatch = Nothing
    Set rSearchList = Nothing
    Set rLookUp = Nothing
End Sub

アイデアは、より動的になり、引数として 2 つの列を受け入れ、検索範囲Range.End(xlDown).Rowを固定数までではなく設定することです。また、一致するトラフのみをループします。

元の質問では、単純な.Cells()ネストされたループの方がはるかに単純ですが.Find()、列数が数千になると、使用がはるかに高速になります。

このテストサブで「ロングリスト」仮説をテストしました：

Private Sub RunTest()
    Dim tStart As Date
    Dim tEnd As Date

    tStart = Timer
    FindAndColorMatchesOfTwoColumns "A", "B"
    tEnd = Timer

    Debug.Print Format(tEnd - tStart, "0.000")


    tStart = Timer
    Test
    tEnd = Timer

    Debug.Print Format(tEnd - tStart, "0.000")
End Sub

列 A に 1500 行、列 B に 184 行を追加し、即時ビューの結果を次のように取得しました。

0,266
12,719

したがって、実際にはパフォーマンスに大きな違いがあります... OPが質問の単純な例を提供するだけで、これをより大きなデータセットで利用するつもりである場合。

于 2013-07-17T10:06:52.193 に答える
0

単純な数行のマクロで、次のように問題を解決できます。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer, j As Integer
For j = 1 To Cells(1, 2).End(xlDown).Row
    For i = 1 To Cells(1, 1).End(xlDown).Row
       If Cells(j, 2) = Cells(i, 1) Then
         Cells(i, 1).Font.ColorIndex = 3
       End If
    Next
Next
End Sub
于 2013-07-17T11:53:00.443 に答える