Wenn Daten identisch, dann Zeile farblich markieren

Sub Tabellenblatt_kopieren() Tabellenblatt_kopieren Makro Sheets("Tabelle1").Select ActiveSheet.Buttons.Add(1.5, 17.25, 136.5, 43.5).Select ActiveSheet.Buttons.Add(1.5, 63, 129, 43.5).Select Sheets("Tabelle1").Copy Before:=Sheets(1) End Sub

Sub Aktualisieren() Aktualisieren Makro Workbooks(1).RefreshAll Application.DisplayAlerts = False Workbooks.Open Filename:="C:\Hs_Daten\Export\Belegdaten.csv", local:=True ActiveWorkbook.SaveAs Filename:="C:\Hs_Daten\Export\Belegdaten.csv", local:=True, _ FileFormat:=xlCSVUTF8, CreateBackup:=False ActiveWindow.Close Workbooks(1).RefreshAll End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ja, natürlich. Es hat sich auch durch "try and error" etwas im bisherigen Code verändert. Ausserdem hat sich gezeigt, dass eine Markierung nur der iedentischen Werte in Spalte A sinnvoller ist, als die ganze Zeile zu markieren.
Ich habe 5 Teil-Makros erstellt und lasse diese in einem zusammen ablaufen:

Sub Alles_Aktualisieren()
' Alles_Aktualisieren Makro
Application.ScreenUpdating = False
Call Tabelle_kopieren
Call Belegmarkierung_loeschen1
Call Aktualisieren
Call Gleiche_Belegnummer
Call Tabelle_loeschen
Application.ScreenUpdating = True
End Sub

Die einzelnen Makros sind wiefolgt aufgebaut:
1. Ich kopiere die aktuelle Tabelle:

Sub Tabelle_kopieren()
' Tabelle_kopieren Makro
Sheets("Tabelle1").Select
Sheets("Tabelle1").Copy Before:=Sheets(1)
Sheets("Tabelle1").Select
End Sub

2. Die bisherige Markierung der Belegnummern wird gelöscht:

Sub Belegmarkierung_loeschen1()
' Belegmarkierung_loeschen1 Makro
Columns("A:A").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

3. Die offene Tabelle "Tabelle1" wird aktualisiert:

Sub Aktualisieren()
' Aktualisieren Makro
Range("E5").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Application.DisplayAlerts = False
Workbooks.Open Filename:="C:\Hs_Daten\Export\Belegdaten.csv", local:=True
ActiveWorkbook.SaveAs Filename:="C:\Hs_Daten\Export\Belegdaten.csv", local:=True, _
FileFormat:=xlCSVUTF8, CreateBackup:=False
ActiveWindow.Close
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
End Sub

4. Doppelte Belegnummern werden mit der kopierten Tabelle verglichen und markiert:

Sub Gleiche_Belegnummer()
' Gleiche_Belegnummer Makro
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim rngQ As Range
Dim rngZ As Range
Dim zellQ As Range
Dim zellZ As Range
Set wksQ = Worksheets("Tabelle1")
Set wksZ = Worksheets("Tabelle1 (2)")
Set rngQ = wksQ.Range("A2:A" & wksQ.Cells(wksQ.Rows.Count, 1).End(xlUp).Row)
Set rngZ = wksZ.Range("A2:A" & wksZ.Cells(wksZ.Rows.Count, 1).End(xlUp).Row)
For Each zellQ In rngQ
For Each zellZ In rngZ
If zellQ = zellZ Then
zellQ.Interior.ColorIndex = 43 'Blau
End If
Next
Next
End Sub

5. Anschließend wird die kopierte Tabelle wieder gelöscht:

Sub Tabelle_loeschen()
' Tabelle_loeschen Makro
Sheets("Tabelle1 (2)").Select
ActiveWindow.SelectedSheets.Delete
End Sub

Bei Verbesserungsvorschlägen bin ich natürlich sehr dankbar. Wichtig ist mir in erster Linie, dass es läuft und das tut es bisher. Generell bin ich sehr dankbar für die Hilfe, die ich hier erhalte und wünsche ein schönes Wochenende!
Beste Grüße

Sub Gleiche_Belegnummer() ' Gleiche_Belegnummer Makro Dim wksQ As Worksheet, wksZ As Worksheet Dim rngQ As Range, rngZ As Range Dim zellQ As Range, zellZ As Range Set wksQ = Worksheets("Tabelle1") Set wksZ = Worksheets("Tabelle1 (2)") Set rngQ = wksQ.Range("A2:A" & wksQ.Cells(wksQ.Rows.Count, 1).End(xlUp).Row) Set rngZ = wksZ.Range("A2:A" & wksZ.Cells(wksZ.Rows.Count, 1).End(xlUp).Row) For Each zellQ In rngQ If WorksheetFunction.CountIf(rngZ, zellQ.Value) > 0 Then zellQ.Interior.ColorIndex = 43 'Blau End If Next Set wksQ = Nothing: Set wksZ = Nothing: Set rngQ = Nothing: Set rngZ = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Wenn Daten identisch, dann Zeile farblich markieren

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wenn Daten identisch, dann Zeile farblich markieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread