Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Dateien miteinander vergleichen, kompliziert.

Dateien miteinander vergleichen, kompliziert.
22.02.2019 12:26:20
Michael
Hallo zusammen,
ich habe momentan eine Aufgabe bei der ich nicht weiterkomme, und würde mich über Hilfe freuen. Ich soll zwei Dateien (Reports) miteinander vergleichen. Bisher habe ich das mit dem folgenden Code hinbekommen:
Sub DateiVergleich(ws1 As Worksheet, ws2 As Worksheet)
Dim ws1Row As Long, ws2Row As Long, ws1col As Long, ws2col As Long
Dim maxrow As Long, maxcol As Long
Dim colval1 As String, colval2 As String
Dim Row As Long, Col As Long
Dim difference As Long
Set report = Workbooks.Add
With ws1.UsedRange
ws1Row = .Rows.Count
ws1col = .Columns.Count
End With
With ws2.UsedRange
ws2Row = .Rows.Count
ws2col = .Columns.Count
End With
maxrow = ws1Row
maxcol = ws1col
If maxrow  colval2 Then
difference = difference + 1
Cells(Row, Col).Formula = colval1 & "  " & colval2
Cells(Row, Col).Interior.Color = 255
Cells(Row, Col).Font.ColorIndex = 2
Cells(Row, Col).Font.Bold = True
End If
Next Row
Next Col
report.Saved = True
If difference = 0 Then
report.Close False
End If
Set report = Nothing
MsgBox diffrences & " Zellen haben unterschiedliche Werte!"
End Sub
Jetzt kam aber die Anforderung dazu, dass sich die Spalten verändern können, und man die Spalten nicht mehr wie durch "Spalte 3 = Spalte 3", sondern durch "Überschrift Spalte 3 = "abc" --> suche Spalte mit Überschrift "abc" und vergleiche diese Spalte mit Spalte 3" vergleichen/überprüfen können soll - das heißt, es soll ein flexibler Spaltenbezug gegeben sein.
Ich hoffe, ich konnte das Problem gut umschreiben und freue mich über Hilfe.
LG

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Wie kompliziert kann das sein ?
22.02.2019 17:14:51
mmat
Hallo,
probier das mal:
Option Explicit
Sub DateiVergleich(ws1 As Worksheet, ws2 As Worksheet)
Dim ws1Row As Long, ws2Row As Long, ws1Col As Long, ws2Col As Long
Dim maxrow As Long, maxcol As Long
Dim colval1 As String, colval2 As String
Dim Row As Long, Col As Long
Dim diffcnt As Long, report As Workbook, hdr As String
Dim MapColumn() As Long, b As Boolean
Set report = Workbooks.Add
With ws1.UsedRange: ws1Row = .Rows.Count: ws1Col = .Columns.Count: End With
With ws2.UsedRange: ws2Row = .Rows.Count: ws2Col = .Columns.Count: End With
maxrow = WorksheetFunction.Max(ws1Row, ws2Row)
maxcol = WorksheetFunction.Max(ws1Col, ws2Col)
ReDim MapColumn(maxcol): For Col = 1 To maxcol: MapColumn(Col) = -1: Next
GoSub SetColumns
diffcnt = 0
For Col = 1 To maxcol
For Row = 1 To maxrow
If MapColumn(Col)  -1 Then
colval1 = ws1.Cells(Row, Col).Formula
colval2 = ws2.Cells(Row, MapColumn(Col)).Formula
If colval1  colval2 Then
diffcnt = diffcnt + 1
Cells(Row, Col).Formula = colval1 & "  " & colval2
Cells(Row, Col).Interior.Color = 255
Cells(Row, Col).Font.ColorIndex = 2
Cells(Row, Col).Font.Bold = True
End If
End If
Next Row
Next Col
report.Saved = True
If diffcnt = 0 Then report.Close False
MsgBox diffcnt & " Zellen haben unterschiedliche Werte!"
Exit Sub
SetColumns:
For Col = 1 To ws1Col
hdr = ws1.Cells(1, Col)
For Row = 1 To ws2Col
If ws2.Cells(1, Row) = hdr Then MapColumn(Col) = Row: Exit For
Next
If MapColumn(Col) = -1 Then MsgBox "Spalte " & hdr & " gibt's net in " & ws2.Name
Next
For Col = 1 To ws2Col
hdr = ws2.Cells(1, Col)
b = True
For Row = 1 To ws1Col
If ws1.Cells(1, Row) = hdr Then b = False: Exit For
Next
If b Then MsgBox "Spalte " & hdr & " gibt's net in " & ws1.Name
Next
Return
End Sub
Sub test()
DateiVergleich Worksheets("Tabelle1"), Worksheets("Tabelle2")
End Sub

Anzeige
AW: Wie kompliziert kann das sein ?
26.02.2019 09:29:52
Michael
Hallo mmat,
offensichtlich für dich weniger kompliziert als für mich - vielen, lieben Dank! Sorry für die späte Antwort - mich hat ein gripaler Infekt komplett aus den Socken gehauen.
LG
Michi
Danke für die Rückmeldung OwT
28.02.2019 16:37:49
mmat

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige