Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Hans5 vom 15.08.2020, 08:51 Options

mehrere Spalten einer Tabelle vergleichen

Hallo zusammen,

möchte mehrere Spalten in einer Tabelle per makro vergleichen.
Verglichen werden sollen A mit B, E mit F, I mit J, usw..... Die Werte sind eigentlich 6-stellig.
Habe diesen Code gefunden, der Spalte A mit B vergleicht. Das Ergebnis ist das gewünschte, ich weiß nur nicht, wie weitere Spalten einbezogen weden.

Option Explicit
Sub vergleichen()
Dim lngI As Long, intWert As Integer
Application.ScreenUpdating = False
For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
intWert = Application.WorksheetFunction. _
CountIf(Worksheets("Tabelle1").Range("B:B"), Cells(lngI, 1).Value)
If intWert > 0 Then
Cells(lngI, 1).Interior.ColorIndex = 44
End If
Next lngI
Application.ScreenUpdating = True
End Sub

Bin für jede Hilfe dankbar.

Antwort schreiben

Antwort 1 von Saarbauer vom 15.08.2020, 09:04 Options

Hallo,

Option Explicit
Sub vergleichen()
Dim lngI As Long, intWert As Integer
Application.ScreenUpdating = False
For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
intWert = Application.WorksheetFunction. _
CountIf(Worksheets("Tabelle1").Range("B:B"), Cells(lngI, 1).Value)
If intWert > 0 Then
Cells(lngI, 1).Interior.ColorIndex = 44
End If
Next lngI

For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row

intWert = Application.WorksheetFunction. _
CountIf(Worksheets("Tabelle1").Range("F:F"), Cells(lngI, 4).Value)

If intWert > 0 Then
Cells(lngI, 1).Interior.ColorIndex = 44
End If
Next lngI
Application.ScreenUpdating = True
End Sub

Den Kusiven Text entsprechend einfügen und die fetten Stellen entsprechend ändern.

Cells(lngI, 4).Value; die 4 steht für "E" bzw. 4. Spalte

Gruß

Helmut

Antwort 2 von Hans5 vom 15.08.2020, 09:55 Options

Hallo Helmut,

danke für die schnelle Antwort.
Leider wird weiterhin nur die 1. Spalte eingefärbt. Hast du noch eine andere Idee?
Warum steht die 4 für spalte "E"? Müsste hier nicht die 5 stehen oder wird Spalte "A" nicht gezählt?

Gruß

Antwort 3 von Saarbauer vom 15.08.2020, 10:01 Options

Hallo,

richtig muss 5 sein

und das muss auch geändert werden

Cells(lngI, 5).Interior.ColorIndex = 44

Gruß

Helmut

Antwort 4 von Hans5 vom 15.08.2020, 10:08 Options

Funktioniert optimal!
Herzlichen Dank.

Antwort 5 von Hans5 vom 15.08.2020, 10:13 Options

Noch etwas.
Gibt es eine Codierung die den Zelleninhalt durchstreicht, anstatt die Zelle farblich zu hinterlegen?

Antwort 6 von rainberg vom 15.08.2020, 10:32 Options

Hallo Hans,

so geht's

Cells(lngI, 5).Font.Strikethrough = True

Gruß
Rainer

Antwort 7 von Hans5 vom 15.08.2020, 10:49 Options

Danke für die Antwort.
Eine letzte Frage noch.
Wenn Spalte D + E verglichen werden und die Werte in Spalte D durchgestrichen, ist es möglich die Werte bzw Texte der Spalten A bis C davon abhängig auch durchzustreichen? Die Funktion ISTWERT ist nicht ganz optimal, daher würde ich eine andere Lösung bevorzugen.

Gruß
Hans

Antwort 8 von nighty vom 15.08.2020, 10:59 Options

hi all

hier noch ein beispiel

gruss nighty

Sub vergleichen1()
ScreenUpdating = False
Dim lngI As Long
Dim zaehler As Long
Dim suche As Range
Rem hier die 16 waere die max anzahl an spalten
Rem verglichen wird nun 1-2 5-6 9-10 13-14
Rem entsprechen zu erhoehen
For zaehler = 1 To 16 Step 4
For lngI = 1 To Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche = Worksheets(1).Range(Cells(1, zaehler + 1), Cells(Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row, zaehler + 1)).Find(Worksheets(1).Cells(lngI, zaehler), Lookat:=xlWhole)
If Not suche Is Nothing And Worksheets(1).Cells(lngI, zaehler) <> "" Then
Worksheets(1).Cells(lngI, zaehler).Interior.ColorIndex = 44
End If
Next lngI
Next zaehler
Application.ScreenUpdating = True
End Sub

Antwort 9 von nighty vom 15.08.2020, 11:02 Options

hi all

ups korrigiert

gruss nighty

Sub vergleichen1()
Application.ScreenUpdating = False
Dim lngI As Long
Dim zaehler As Integer
Dim suche As Range
For zaehler = 1 To 16 Step 4
For lngI = 1 To Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Set suche = Worksheets(1).Range(Cells(1, zaehler + 1), Cells(Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row, zaehler + 1)).Find(Worksheets(1).Cells(lngI, zaehler), Lookat:=xlWhole)
If Not suche Is Nothing And Worksheets(1).Cells(lngI, zaehler) <> "" Then
Worksheets(1).Cells(lngI, zaehler).Interior.ColorIndex = 44
End If
Next lngI
Next zaehler
Application.ScreenUpdating = True
End Sub

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..