試圖比較列a中的單元格與列b中的單元格vba

Question

我是VBA的新手，並且在找到我需要的答案方面相當成功，直到現在。我想在列A中取一個值，看看它是否出現在列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. 單元格和範圍被引用到th e帶有點的Activesheet。
2. 我已經更新了循環，所以它們看起來更好。
3. 我做了一個特殊的子PaintMe，它描繪了左側和右側的列。
4. 我避免使用ActiveCell，因爲它是緩慢而艱難的 - 看到更多的在這裏 - How to avoid using Select in Excel VBA macros

這是輸出的一個樣本：

在一般情況下，這樣的解決方案是相當不專業的，因爲它有一個algorithm complexity of n²，這可能是這種問題的最壞情況。你有兩個循環內相互，這是最慢的解決方案。一般來說，有更好的方法可以做到這一點。但對於excel來說，它應該起作用。