2017-04-21 5 views
1

Ich bin ziemlich neu in VBA, und bin ziemlich erfolgreich darin gewesen, die Antworten zu finden, die ich brauche, bis jetzt. Ich möchte einen Wert in Spalte A nehmen und sehen, ob er in Spalte B erscheint und eine Aktion ausführen, wenn er den Wert findet und dann die nächste Spalte in Spalte B gehe. Ich fühle mich wie nahe dran, nur etwas nicht richtig zu bekommen.Der Versuch, Zellen in Spalte a mit Zellen in Spalte b zu vergleichen vba

Hier ist, was ich eine mögliche Lösung des Problems bisher

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 
+0

Können Sie beschreiben, was nicht funktioniert? Was macht es und was soll es tun? –

+0

@RichHolton sagte, könnten Sie bitte beschreiben, was nicht funktioniert? –

Antwort

0
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 
0

ist hier versucht haben, so viel von Ihrem Code wie möglich zu verwenden:

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 

Was ich habe, erledigt:

  1. Die Zellen und die Bereiche sind th th verwiesen e Aktives Blatt mit einem Punkt.
  2. Ich habe die Loops aktualisiert, damit sie besser aussehen.
  3. Ich habe eine spezielle Unter PaintMe gemacht, die sowohl die linke als auch die rechte Spalte malt.
  4. Ich habe mit Active vermieden, weil es langsam und schwierig ist - mehr hier sehen - How to avoid using Select in Excel VBA macros

Das ist ein Beispiel für die Ausgabe ist:

enter image description here

Im Allgemeinen wird eine Lösung wie diese ist ziemlich nicht professionell, weil es eine algorithm complexity of n² hat, die wahrscheinlich der schlimmste Fall für diese Art von Problem ist. Sie haben zwei Schleifen ineinander, und das ist die langsamste Lösung. Es gibt im Allgemeinen viel bessere Möglichkeiten, dies zu tun. Aber für Excel sollte es funktionieren.

Verwandte Themen