Thema Datum  Von Nutzer Rating
Antwort
Rot 2 Tabellen miteinander vergleichen - Unterschiedliche Zellen markieren!
21.03.2014 11:31:50 TimmTimm
NotSolved
21.03.2014 14:23:21 Gast31345
Solved
24.03.2014 10:26:59 Gast73489
NotSolved
21.03.2014 23:40:08 Gast5279
Solved
24.03.2014 13:44:43 TimmTimm
NotSolved

Ansicht des Beitrags:
Von:
TimmTimm
Datum:
21.03.2014 11:31:50
Views:
2041
Rating: Antwort:
  Ja
Thema:
2 Tabellen miteinander vergleichen - Unterschiedliche Zellen markieren!

Hallo liebes VBAForum,

ich bin ein blutiger VBA-Anfänger und weiß teilweise gar nicht, was ich tue. Mühsam habe ich ein Programm gebaut (danke, Herber.de!) welches nach dem Start eine Userform öffnet, in der man zwei Tabellen öffnen kann, die einmal in "Tabelle 1" und einmal in "Tabelle 2" geöffnet werden. Durch einen dritten Button lassen sich die Daten miteinander vergleichen und Unterschiede werden farblich markiert.

Das klappt soweit gut, aber es werden ganze Zeilen markiert, ich möchte aber nur, dass die jeweiligen Zellen markiert werden. "Rows" durch "Cells" ersetzen habe ich schon versucht. Leider bin ich nun an der Grenze meines "Wochend-Seminar-Wissens". Danke im Voraus!

Hier der Code erstmal für das importieren:
Private Sub CommandButton3_Click()
Dim ImportDatei As Variant
Dim wbImport As Workbook

ImportDatei = Application.GetOpenFilename(FileFilter:="Microsoft Excel-Dateien (*.xls; *.xlsx; *.xlsm),*.xls; *.xlsx; *.xlsm", Title:="Eine Datei auswählen")

If ImportDatei = False Then Exit Sub

Set wbImport = Workbooks.Open(ImportDatei)


Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Vergleich.xlsm").Activate
Sheets("Alt").Select
Cells.Select
ActiveSheet.Paste

End Sub


----------------------------------------
Und hier der Code für den Vergleich:


Private Sub CommandButton2_Click()


Dim rng As Range
Dim lRow As Long, lRowT As Long
Dim iCol As Integer
Dim bln As Boolean
Set rng = Worksheets("Alt").Range("A1").CurrentRegion
Sheets("Aktuell").Activate
For lRow = 1 To Range("A1").CurrentRegion.Rows.Count

bln = True
For lRowT = 1 To rng.Rows.Count

For iCol = 1 To 400
If Cells(lRow, iCol) <> rng(lRowT, iCol) Then
bln = False
Exit For
End If
Next iCol
If bln = True Then
Exit For
ElseIf lRowT < rng.Rows.Count Then

bln = True
End If
Next lRowT
If bln = False Then
Range(Cells(lRow, 1), Cells(lRow, 400)).Interior.ColorIndex = 6
'Range(Cells(lRow, iCol), Cells(lRow, iCol)).Interior.ColorIndex = 6

End If
Next lRow
Range("A1").Select
Unload Me

End Sub


P.S.: Wie kann ich dann noch erreichen, dass wenn ich eine Mappe öffne, diese aber aus mehreren Tabellenblätter besteht, ich alle Seiten importieren kann?


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot 2 Tabellen miteinander vergleichen - Unterschiedliche Zellen markieren!
21.03.2014 11:31:50 TimmTimm
NotSolved
21.03.2014 14:23:21 Gast31345
Solved
24.03.2014 10:26:59 Gast73489
NotSolved
21.03.2014 23:40:08 Gast5279
Solved
24.03.2014 13:44:43 TimmTimm
NotSolved