Microsoft Excel

Herbers Excel/VBA-Archiv

Doppelte markieren - mehrere Spalten | Herbers Excel-Forum


Betrifft: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 11:19:43

Hallo Excel-Profis,

ich habe mal wieder ein Problem an dem ich mir die Zähne ausbeisse:

Ich bekomme eine Liste mit ca. 1000 Zeilen Datensätzen. Jetzt kann es sein, das Einträge (Rechnungen) doppelt erfasst worden sind.

Die Rechnungsnummer steht in Spalte G (also 7)

Jetzt habe ich ein Makro gefunden welches mit die doppelten markiert:

Public Sub Doppelte_RotOhneLeer()
Dim lngZeile As Long
Dim lngZeilenSprung As Long
Dim strSuchwert As String

lngZeile = Cells(Rows.Count, 7).End(xlUp).Row

  For lngZeilenSprung = lngZeile To 1 Step -1
    strSuchwert = Cells(lngZeilenSprung, 7).Value
    If strSuchwert <> "" Then
      If Application.WorksheetFunction.CountIf(Range(Cells(1, 7), Cells(lngZeile, 7)),  _
strSuchwert) <> 1 Then
        Cells(lngZeilenSprung, 7).Interior.ColorIndex = 3
      End If
    End If
  Next lngZeilenSprung
End Sub
Leider markiert er mir nicht alle doppelten; ich habe z.B. 2011-001 mehrfach in Spalte G und es wird nicht markiert.

Ausserdem müßte ich noch die Spalten H, I und J mit in die Prüfung mit einbeziehen - es sollen also nur doppelte markiert werden, die in den Spalten G - J überall den gleichen Eintrag haben.

Geht das - und wenn ja wie?

Vielen Dank für Eure Hilfe und viele Grüße Lutz

  

Betrifft: warum nicht bed. Formatierung? owT von: Rudi Maintaire
Geschrieben am: 03.01.2012 11:46:49




  

Betrifft: AW: warum nicht bed. Formatierung? owT von: Wilfried Höttl
Geschrieben am: 03.01.2012 12:03:23

Hallo!

Mit bed. Formation.

Tipp1

 ABCD
254Duplikate mehrere Spalten kenntlich machen   
255    
25623202332
257454245Willi
258Sepp101102103
25999Sepp43

Bedingte Formatierungen der Tabelle
ZelleNr.: / BedingungFormat
A2551. / Formel ist =ZÄHLENWENN(A$200:A256;A256)>1Abc
A2561. / Formel ist =ZÄHLENWENN($A$256:$D$259;A256)>1Abc
B2561. / Formel ist =ZÄHLENWENN($A$256:$D$259;B256)>1Abc
C2561. / Formel ist =ZÄHLENWENN($A$256:$D$259;C256)>1Abc
D2561. / Formel ist =ZÄHLENWENN($A$256:$D$259;D256)>1Abc
A2571. / Formel ist =ZÄHLENWENN($A$256:$D$259;A257)>1Abc
B2571. / Formel ist =ZÄHLENWENN($A$256:$D$259;B257)>1Abc
C2571. / Formel ist =ZÄHLENWENN($A$256:$D$259;C257)>1Abc
D2571. / Formel ist =ZÄHLENWENN($A$256:$D$259;D257)>1Abc
A2581. / Formel ist =ZÄHLENWENN($A$256:$D$259;A258)>1Abc
B2581. / Formel ist =ZÄHLENWENN($A$256:$D$259;B258)>1Abc
C2581. / Formel ist =ZÄHLENWENN($A$256:$D$259;C258)>1Abc
D2581. / Formel ist =ZÄHLENWENN($A$256:$D$259;D258)>1Abc
A2591. / Formel ist =ZÄHLENWENN($A$256:$D$259;A259)>1Abc
B2591. / Formel ist =ZÄHLENWENN($A$256:$D$259;B259)>1Abc
C2591. / Formel ist =ZÄHLENWENN($A$256:$D$259;C259)>1Abc
D2591. / Formel ist =ZÄHLENWENN($A$256:$D$259;D259)>1Abc


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4



Gruß
Wilfried


  

Betrifft: AW: warum nicht bed. Formatierung? owT von: lutz
Geschrieben am: 03.01.2012 13:00:57

Hallo Wilfried,

vielen Dank, leider bekomme ich die Datei immer täglich von einem Download neu...

Deswegen wäre VBA besser.

Viele Grüße Lutz


  

Betrifft: AW: warum nicht bed. Formatierung? owT von: lutz
Geschrieben am: 03.01.2012 12:47:31

Hallo, brauche VBA weil ich die Datei immer geliefert bekomme - dann nehme ich das Marko in eine Personl.xls...

Vielen Dank und viele Grüße Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: Josef Ehrensberger
Geschrieben am: 03.01.2012 11:55:56


Hallo Lutz,

probiere es so.

Public Sub Doppelte_RotOhneLeer()
  Dim rng As Range, lngLast As Long
  
  With ActiveSheet
    lngLast = Application.Max(2, Cells(Rows.Count, 7).End(xlUp).Row)
    .Columns(7).Interior.ColorIndex = xlNone
    .Columns(11).Insert
    .Columns(11).Insert
    .Range(.Cells(2, 11), .Cells(lngLast, 11)).Formula = "=G2&H2&I2&J2"
    .Range(.Cells(2, 12), .Cells(lngLast, 12)).Formula = _
      "=IF(COUNTIF($K$2:$K$" & lngLast & ",K2)>1,TRUE(),"""")"
    On Error Resume Next
    Set rng = .Columns(12).SpecialCells(xlCellTypeFormulas, xlLogical)
    On Error GoTo 0
    If Not rng Is Nothing Then
      rng.Offset(0, -5).Interior.ColorIndex = 3
    End If
    .Columns(11).Delete
    .Columns(11).Delete
  End With
  
  Set rng = Nothing
End Sub






« Gruß Sepp »



  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 12:59:14

Hallo Sepp,

vielen Dank - leider ist die Datei daneben schon gefüllt...

Geht es nicht so wie mit meinem Makro-Entwurf, nur eben das er die 3 Spalten statt der einen vergleicht?


Bei mir geht der Bereich ab Zeile 7 los - habe das mal so geändert:

Sub Doppelte_RotOhneLeer_SP()
  Dim rng As Range, lngLast As Long
  
  With ActiveSheet
    lngLast = Application.Max(7, Cells(Rows.Count, 7).End(xlUp).Row)
    .Columns(7).Interior.ColorIndex = xlNone
    .Columns(11).Insert
    .Columns(11).Insert
    .Range(.Cells(7, 11), .Cells(lngLast, 11)).Formula = "=G7&H7&I7&J7"
    .Range(.Cells(7, 12), .Cells(lngLast, 12)).Formula = _
      "=IF(COUNTIF($K$7:$K$" & lngLast & ",K7)>1,TRUE(),"""")"
    On Error Resume Next
    Set rng = .Columns(12).SpecialCells(xlCellTypeFormulas, xlLogical)
    On Error GoTo 0
    If Not rng Is Nothing Then
      rng.Offset(0, -5).Interior.ColorIndex = 3
    End If
    .Columns(11).Delete
    .Columns(11).Delete
  End With
    Set rng = Nothing
End Sub
Trotzdem markiert er mir nur ein paar Zeilen bei denen in Spalte G leere sind - wenn ich unten in der Liste die letzten 5 Sätze einfach von G bis K kopiere dann markiert er die nicht rot.

Viele Grüße Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 13:01:23

Hallo Sepp,

vielen Dank - leider ist die Datei daneben schon gefüllt...

Geht es nicht so wie mit meinem Makro-Entwurf, nur eben das er die 3 Spalten statt der einen vergleicht?


Bei mir geht der Bereich ab Zeile 7 los - habe das mal so geändert:

Sub Doppelte_RotOhneLeer_SP()
  Dim rng As Range, lngLast As Long
  
  With ActiveSheet
    lngLast = Application.Max(7, Cells(Rows.Count, 7).End(xlUp).Row)
    .Columns(7).Interior.ColorIndex = xlNone
    .Columns(11).Insert
    .Columns(11).Insert
    .Range(.Cells(7, 11), .Cells(lngLast, 11)).Formula = "=G7&H7&I7&J7"
    .Range(.Cells(7, 12), .Cells(lngLast, 12)).Formula = _
      "=IF(COUNTIF($K$7:$K$" & lngLast & ",K7)>1,TRUE(),"""")"
    On Error Resume Next
    Set rng = .Columns(12).SpecialCells(xlCellTypeFormulas, xlLogical)
    On Error GoTo 0
    If Not rng Is Nothing Then
      rng.Offset(0, -5).Interior.ColorIndex = 3
    End If
    .Columns(11).Delete
    .Columns(11).Delete
  End With
    Set rng = Nothing
End Sub
Trotzdem markiert er mir nur ein paar Zeilen bei denen in Spalte G leere sind - wenn ich unten in der Liste die letzten 5 Sätze einfach von G bis K kopiere dann markiert er die nicht rot.

Viele Grüße Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: Josef Ehrensberger
Geschrieben am: 03.01.2012 13:02:56


Hallo Lutz,

"vielen Dank - leider ist die Datei daneben schon gefüllt..."

und? Hast du meinen Code getestet? Mein Code fügt temporär zwei Spalten ein und löscht sie nach Ablauf des Codes wieder, wo liegt dabei dein Problem?




« Gruß Sepp »



  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 13:21:18

Hallo Sepp,

stimmt, habe ich auch gesehen - wie beschrieben markiert er aber leider nicht alle doppelten; warum auch immer.

Viele Grüße Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: Josef Ehrensberger
Geschrieben am: 03.01.2012 13:05:11


Hallo Lutz,

lade doch mal eine Beispieldatei hoch, bei der angeblich die Doppelten nicht gekennzeichnet werden.




« Gruß Sepp »



  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 13:45:33

Hallo Sepp,

mußte mal etwas puzzeln...

So geht es jetzt:

Sub Doppelte_RotOhneLeer_SP()
  Dim rng As Range, lngLast As Long
  
  With ActiveSheet
    lngLast = Application.Max(7, Cells(Rows.Count, 3).End(xlUp).Row)  ' ------------------------ _
--------------------------nur Spalte C ist immer gefüllt
    .Columns(7).Interior.ColorIndex = xlNone
    .Columns(11).Insert
    .Columns(11).Insert
    .Range(.Cells(7, 11), .Cells(lngLast, 11)).Formula = "=G7&H7&I7&J7" ' Bereich startet erst  _
in 7...
    .Range(.Cells(7, 12), .Cells(lngLast, 12)).Formula = _
      "=IF(COUNTIF($K$7:$K$" & lngLast & ",K7)>1,TRUE(),"""")"
    On Error Resume Next
    Set rng = .Columns(12).SpecialCells(xlCellTypeFormulas, xlLogical)
    On Error GoTo 0
    If Not rng Is Nothing Then
      rng.Offset(0, -6).Interior.ColorIndex = 3  ' --------------------------------------------- _
hier war der Fehler: in Spalte G waren manche schon grün die hat er nicht auf rot gesetzt...
    End If
    .Columns(11).Delete
    .Columns(11).Delete
  End With
    Set rng = Nothing
End Sub

Eine Frage noch:

Ich habe Zeilen da steht in G:J gar nichts drin, die sollte er auch nicht rot markieren - geht das??


Vielen Dank in jedem Fall schon einmal und viele Grüße Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: Josef Ehrensberger
Geschrieben am: 03.01.2012 13:52:40


Hallo Lutz,


wenn in Spalte G manche Zellen nicht auf rot gesetzt werden, dann hast du dort eine bedingte Formatierung drin, mein Code löscht nämlich die Hintergrundfarbe vor der Überprüfung.

Sub Doppelte_RotOhneLeer_SP()
  Dim rng As Range, lngLast As Long
  
  With ActiveSheet
    lngLast = Application.Max(7, Cells(Rows.Count, 3).End(xlUp).Row) ' ------------------------ _
      --------------------------nur Spalte C ist immer gefüllt

    .Columns(6).Interior.ColorIndex = xlNone
    .Columns(11).Insert
    .Columns(11).Insert
    .Range(.Cells(7, 11), .Cells(lngLast, 11)).Formula = "=G7&H7&I7&J7" ' Bereich startet erst _
      in 7...

    .Range(.Cells(7, 12), .Cells(lngLast, 12)).Formula = _
      "=IF((COUNTIF($K$7:$K$" & lngLast & ",K7)*(Len(K7)>0))>1,TRUE(),"""")"
    On Error Resume Next
    Set rng = .Columns(12).SpecialCells(xlCellTypeFormulas, xlLogical)
    On Error GoTo 0
    If Not rng Is Nothing Then
      rng.Offset(0, -6).Interior.ColorIndex = 3 ' --------------------------------------------- _
        hier war der Fehler: in Spalte G waren manche schon grün die hat er nicht auf rot gesetzt...

    End If
    .Columns(11).Delete
    .Columns(11).Delete
  End With
  Set rng = Nothing
End Sub




« Gruß Sepp »



  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 14:08:35

Hallo Sepp,

stimmt, ich hatte das auch schon gesehen aber nicht an bed. Formatierung gedacht (ist auch nicht meine Datei).

Kann man das noch wegfiltern, das er bei leeren Zeilen in G bis J auch alles rot färbt?


Vielen Dank für deine Mühe, Gruß Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: Josef Ehrensberger
Geschrieben am: 03.01.2012 14:18:06


Hallo Lutz,

jetzt kenn ich mich nicht mehr aus.

Zuerst willst du das leere Zeilen (G:J) NICHT markiert werden, jetzt sollen sie auf einmal markiert werden.

Was meinst du mit "wegfiltern"

Mach mal ein paar konkrete Ansagen, sonst wird das ein Bandwurm-Thread.




« Gruß Sepp »



  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 15:18:40

Sorry, wenn ich etwas ungenau war...

Es geht nur darum jene Zeilen nicht rot zu markieren in denen in den Spalten G:J nichts steht (gibt es leider auch und die nimmt er dann natürlich als doppelte).

Viele Grüße Lutz


  

Betrifft: genau das berücksichtigt mein Code! o.T. von: Josef Ehrensberger
Geschrieben am: 03.01.2012 15:47:49

« Gruß Sepp »



  

Betrifft: AW: genau das berücksichtigt mein Code! o.T. von: lutz
Geschrieben am: 03.01.2012 15:57:20

Hallt Sepp,

stimmt, da war nur eine Formel noch drin.

Vielen lieben Dank für Deine Hilfe und noch einen schönen Tag für Dich.

Viele Grüße Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: fcs
Geschrieben am: 03.01.2012 15:14:54

Hallo Lutz,

hier noch eine Variante ohne Hilfsspalten.
Die Info ob Zeile doppelt wird innerhalb des Makros in einem Daten-Array zwischengespeichert bevor die doppelten Zeilen markiert werden.

Gruß
Franz

Public Sub Doppelte_RotOhneLeer_var1()
   Dim lngZeile As Long
   Dim lngZ As Long
   Dim varSuchwert As Variant
   Dim Zelle As Range, Adresse1 As String
   Dim arrDoppelt() As Boolean
   Dim wks As Worksheet
   Set wks = ActiveSheet
   With wks
      'Letzte Zeile Spalte 7 (G)
      lngZeile = .Cells(.Rows.Count, 7).End(xlUp).Row
      'Array für Doppelte initialisieren
      ReDim arrDoppelt(1 To lngZeile)
      'Zeilen prüfen
      For lngZ = 1 To lngZeile - 1
        varSuchwert = .Cells(lngZ, 7)
        If varSuchwert <> "" And arrDoppelt(lngZ) = False Then
          'Rechnungsnummer im Rest der Liste suchen
          With .Range(.Cells(lngZ + 1, 7), .Cells(lngZeile, 7))
            Set Zelle = .Find(what:=varSuchwert, LookIn:=xlValues, lookat:=xlWhole)
            If Not Zelle Is Nothing Then
              Adresse1 = Zelle.Address 'Zelladresse der 1. Fundstelle merken
              Do
                With wks
                  'Prüfen, ob Spalten H bis J identisch
                  If .Cells(lngZ, 8).Value = .Cells(Zelle.Row, 8).Value _
                    And .Cells(lngZ, 9).Value = .Cells(Zelle.Row, 9).Value _
                    And .Cells(lngZ, 10).Value = .Cells(Zelle.Row, 10).Value Then
                      'Zeilen als doppelt merken
                      arrDoppelt(lngZ) = True
                      arrDoppelt(Zelle.Row) = True
                  End If
                End With
                'nächste Fundstelle suchen
                Set Zelle = .FindNext(after:=Zelle)
              Loop Until Zelle.Address = Adresse1
            End If
          End With
        End If
     Next lngZ
     Application.ScreenUpdating = False
     'Hintergrundfarbe in Spalten G bis J löschen
     .Range(.Cells(1, 7), .Cells(lngZeile, 10)).Interior.ColorIndex = xlColorIndexNone
     'Doppelte Einträge rot markierne
     For lngZ = 1 To lngZeile - 1
          If arrDoppelt(lngZ) = True Then
              .Range(.Cells(lngZ, 7), .Cells(lngZ, 10)).Interior.ColorIndex = 3
          End If
     Next lngZ
     Application.ScreenUpdating = True
   End With
   Erase arrDoppelt
   Set wks = Nothing: Set Zelle = Nothing
End Sub



  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 15:24:30

Hallo Franz,

wow - vielen Dank, das geht wirklich gut. Er berücksichtigt auch die Leeren nicht mehr!


Eines ist mir aufgefallen: ich habe die letzte Zeile 6x kopiert - der Code markiert aber nur 5 von den 6 - ist vielleicht irgendwo eine -1 oder + 1 zuviel oder fehlt??

In jedem Fall schon mal tausend Dank - es ist schon irre welche Lösungsmöglichkeiten es alle gibt...

Viele Grüße Lutz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: fcs
Geschrieben am: 03.01.2012 15:36:48

Hallo Lutz,

in der For-Next-Schleife zum Markieren ist der To-Wert falsch.
Korrektur:

     'Doppelte Einträge rot markieren
     For lngZ = 1 To lngZeile
Gruß
Franz


  

Betrifft: AW: Doppelte markieren - mehrere Spalten von: lutz
Geschrieben am: 03.01.2012 15:56:11

Hallo Franz,

vielen Dank - Perfekt!!!

Ich wünsche Dir noch einen schönen Tag.

Viele Grüße Lutz


Beiträge aus den Excel-Beispielen zum Thema "Doppelte markieren - mehrere Spalten"