mit VBA 2 Blätter vergleichen

[Rabe]

Hi Sven,

Kann man eigentlich die Schrift im Feld dann auch Fett und Rot machen ?

klar:

Option Explicit



Const Farbe = 15   'Innenfarbe Hellgrau 



Private Sub Worksheet_Change(ByVal Target As Range)

  Dim AC As Object

  Dim lngLetzte As Long

  Dim lngLetzte2 As Long

  

  Worksheets("Vergleich neu").Select

  lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 

  lngLetzte2 = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte belegte Spalte in Zeile 1 

  

  'Schleife zum vergleichen und markieren 

  For Each AC In Range("A1:SD" & lngLetzte)

     With Worksheets("Vergleich alt")

        If .Cells(AC.Row, AC.Column) <> AC.Value Then

           AC.Interior.ColorIndex = Farbe

           AC.Font.Color = -16776961

           AC.Font.TintAndShade = 0

           AC.Font.Bold = True

        End If

     End With

  Next AC

End Sub



Sub entfärben()

  Dim lngLetzte As Long

  

  lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 

  

  With Range("A1:SD" & lngLetzte)

     .Interior.ColorIndex = xlNone

     .Font.ColorIndex = xlAutomatic

     .Font.TintAndShade = 0

     .Font.Bold = False

  End With

End Sub

Nun kann noch lngLetzte2 anstelle von SD verwendt werden:

Option Explicit

Const Farbe = 15   'Innenfarbe Hellgrau 

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim AC As Object
   Dim lngLetzte As Long
   Dim lngLetzte2 As Long
   
   Worksheets("Vergleich neu").Select
   lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 
   lngLetzte2 = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte belegte Spalte in Zeile 1 

   'Schleife zum vergleichen und markieren 
   For Each AC In Range(Cells(1, 1), Cells(lngLetzte, lngLetzte2)) 'Range("A1:SD" & lngLetzte) 
      With Worksheets("Vergleich alt")
         If .Cells(AC.Row, AC.Column) <> AC.Value Then
            AC.Interior.ColorIndex = Farbe
            AC.Font.Color = -16776961
            AC.Font.TintAndShade = 0
            AC.Font.Bold = True
         End If
      End With
   Next AC
End Sub

Sub entfärben()
   Dim lngLetzte As Long
   Dim lngLetzte2 As Long
   
   Worksheets("Vergleich neu").Select
   lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row    ' letzte belegte in Spalte A (1) 
   lngLetzte2 = Cells(1, Columns.Count).End(xlToLeft).Column 'letzte belegte Spalte in Zeile 1 
   
   With Range(Cells(1, 1), Cells(lngLetzte, lngLetzte2))
      .Interior.ColorIndex = xlNone
      .Font.ColorIndex = xlAutomatic
      .Font.TintAndShade = 0
      .Font.Bold = False
   End With
End Sub

[svenham]

Das klappt ! Super Danke.