カラムaの細胞をカラムb vbaの細胞と比較しようとしています

Question

私はVBAには新しく、今までの答えを見つけるのに成功しました。私は列Aで1つの値を取って、列Bに表示されているかどうかを調べ、値を見つけて次に列Bの次の列に移動するときにアクションを実行したいと思います。ここで

は、私はここで、これまで

Sub Macro1() 
' 
' Macro1 Macro    
    Dim currentA As String 
    Dim currentB As String 
    Dim a As Integer 
    Dim b As Integer 
    a = 2 
    b = 1 

    Do Until IsEmpty(ActiveCell) 
     Cells(a, b).Select 
     currentA = ActiveCell 
     Debug.Print (currentA) 
     a = a + 1 

     Range("b2").Select    
     Do Until IsEmpty(ActiveCell)     
      currentB = ActiveCell     
      If currentA = currentB Then 
       With Selection.Interior 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent1 
        .Color = 65535 
        .PatternTintAndShade = 0 
        .TintAndShade = 0 
       End With 
      End If 

      Debug.Print (currentA)     
      ActiveCell.Offset(1, 0).Select 
     Loop          
    Loop 
End Sub 

Answer 1

Sub CompareCells() 
Dim CellInColA As Range 
Dim CellInColB As Range 
    For Each CellInColA In Application.Intersect(ActiveSheet.UsedRange, Columns("A").Cells) 
    For Each CellInColB In Application.Intersect(ActiveSheet.UsedRange, Columns("B").Cells) 
     If CellInColB = CellInColA Then 
     'found it - do whatever 
     CellInColB.Interior.ColorIndex = 3 
     Exit For 
     End If 
    Next CellInColB 
    Next CellInColA 
End Sub 

Answer 2

を試してみたものです可能な限りあなたのコードからできるだけ多くを使用して、あなたの問題の可能な解決策である：

Option Explicit 

Sub TestMe() 

    Dim currentA As String 
    Dim currentB As String 

    Dim a   As Long 
    Dim b   As Long 

    Dim cellA  As Range 
    Dim cellB  As Range 

    a = 2 
    b = 1 

    With ActiveSheet 
     Set cellA = .Range("A2") 

     Do Until IsEmpty(cellA) 
      Set cellA = .Cells(a, b) 
      a = a + 1 

      Set cellB = .Range("B2") 

      Do Until IsEmpty(cellB) 
       If cellA.Value = cellB.Value Then 
        PaintMe cellA 
        PaintMe cellB 
       End If 

       Set cellB = cellB.Offset(1, 0) 
      Loop 
     Loop 

    End With 
End Sub 

Public Sub PaintMe(cellA As Range) 

    With cellA.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorAccent1 
     .Color = 65535 
     .PatternTintAndShade = 0 
     .TintAndShade = 0 
    End With 

End Sub 

私が持っているもの完了：

1. セルとその範囲は、 eアクティブシートにドットが付いています。
2. 私はループを更新したので、見た目が良くなりました。
3. 私は特別なサブPaintMeを作って、左右の両方の列をペイントしました。それは遅いと困難であるため
4. 私は、ActiveCellのを使用して避けてきた - ここでは詳細を参照 - 出力のサンプルですHow to avoid using Select in Excel VBA macros

：一般的に

、このようなソリューションをそれはalgorithm complexity of n²を持っているので、プロフェッショナルではありません。これはおそらく、この種の問題の最悪の場合です。お互いに2つのループがあり、可能な限り最速のソリューションです。一般的には、もっと良い方法があります。しかし、優れているため、それは動作するはずです。