Supportnet / Forum / Tabellenkalkulation

Hallo, ich beschäftige mich nun seit ein paar Tagen mit dem Dateivergleich zwischen zwei Excel Dateien. Es sind monatliche Listen mit ca.14 Spalten und ca. 400 Zeilen. In diesen Dateien soll nun verglichen werden was sich im Vergleich zum letzten Monat verändert hat. Wenn möglich sollen dann nur die abweichenden Zeilen ausgegeben bzw. markiert werden. Nach langer Forumrecherche hab ich mich für die Variante entschieden: [url]http://clever-forum.de/read.php?11,121369,121890[/url] Hier kann man über Schaltflächen die 2 Dateien auswählen. Leider ist das Ergebnis nicht so, wie ich es gerne hätte. Ich habe es schon ein bißchen umgeschriebn, so dass nur die ungleichen Zeilen markiert werden. Und zudem gibt es das Problem, dass wenn eine Zeile hinzu kommt ist der Rest auch falsch. Das habe ich nicht hinbekommen. Hier mal das Makro (schon ein bißchen verändert): Public Tab1, Tab2 Sub vergleichen() Dim wkb1 As Workbook Dim wkb2 As Workbook Dim sh As Integer Dim Reihe As Long Dim Spalte As Integer Application.ScreenUpdating = False 'Datei nicht vorhanden 'If IsEmpty(Cells(3, 1)) Or IsEmpty(Cells(7, 1)) Then GoTo DateiFehlt 'If Dir(Cells(3, 1).Value) = "" Or Dir(Cells(7, 1).Value) = "" Then GoTo DateiFehlt Set wkb2 = Workbooks.Open(Cells(7, 1).Value, ReadOnly:=True) Tab1 = ActiveWorkbook.Name Windows("datei_laden.xls").Activate Set wkb1 = Workbooks.Open(Cells(3, 1).Value, ReadOnly:=True) Tab2 = ActiveWorkbook.Name For sh = 1 To wkb1.Worksheets.Count 'Schleife über die Blätter '************************************************************* 'letzte Zeile suchen Dim LZ As Long With ActiveSheet LZ = .Cells.Find(What:="*", After:=Range("A1"), _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With '**************************************************************** 'letzte Spalte suchen Dim LS As Long ActiveCell.SpecialCells(xlLastCell).Select LS = ActiveCell.SpecialCells(xlLastCell).Column '**************************************************************** For Spalte = 1 To LS For Reihe = 1 To LZ If wkb1.Worksheets(sh).Cells(Reihe, Spalte) <> wkb2.Worksheets(sh).Cells(Reihe, Spalte) Then wkb1.Worksheets(sh).Cells(Reihe, Spalte).Interior.ColorIndex = 3 'Hier wird in die Spalte "A" eine Farbe angegeben, damit man weiß, in welcher Zeile ein Unterschied ist 'wkb1.Worksheets(sh).Cells(Reihe, 1).Interior.ColorIndex = 8 End If Next Reihe Next Spalte Next sh Call weiter Exit Sub DateiFehlt: MsgBox "Bitte zuerst Dateiauswahl treffen!", vbOKOnly, "Fehler: Datei nicht ausgewählt!" End Sub Private Sub weiter() Dim LZ As Long With ActiveSheet LZ = .Cells.Find(What:="*", After:=Range("A1"), _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With 'Range("A6").Select 'Jetzt werden die Zeilen gelöscht, in der keine Kontr.-Nummer ist aber eine Änderung vorhanden ist (z.B. Summen) For x = x To LZ If ActiveCell = "" Or ActiveCell.Interior.ColorIndex <> 8 Then Rows(ActiveCell.Row).Delete ActiveCell.Offset(-1).Select End If ActiveCell.Offset(1).Select Next Rows(2).Delete Rows(1).Delete Selection.End(xlUp).Select Selection.CurrentRegion.Select Selection.Copy Windows("datei_laden.xls").Activate Range("A13").Select ActiveSheet.Paste Range("A13").Select Application.DisplayAlerts = False Windows(Tab1).Close Windows(Tab2).Close Application.ScreenUpdating = True End Sub ------ Option Explicit Private Sub cmb_Auswertung_Click() Call vergleichen End Sub Private Sub cmb_Datei1_Click() 'Pfad + Datei wird in Zelle A7 abgelegt Cells(7, 1).Value = Datei_Suchen Range("A1").Select End Sub Private Sub cmb_Datei2_Click() ''Pfad + Datei wird in Zelle A3 abgelegt Cells(3, 1).Value = Datei_Suchen Range("A1").Select End Sub Private Function Datei_Suchen() As String Dim fd As FileDialog With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = False If .Show = 0 Then Exit Function Datei_Suchen = .SelectedItems(1) End With End Function

Hi

Check bitte mal folgendes Beispiel:
http://www.excel-im-unternehmen.de/SID81.MWlEjUf6Mos /DataCenter/News/1129197612.37/Downloads/Inventur.xls

Vielleicht bringt es Dich weiter.

^{*Threadedit* 16:56:39, 07.04.2008
Admininfo: Achte bei Links bitte auf unsere Formatierungshilfe oder nutze das SNTool}

vielen dank. das werde ich gleich morgen mal ausprobieren.

das war schon mal die richtige richtung :) habs ein bißchen umgeschrieben:

Sub Inventurabgleich()
Const Blatt1 = "kust vormonat"
Const Blatt2 = "kust"
Dim artnr As String
Dim b As Boolean

Sheets(Blatt2).Activate
Range("A2").Select
Do Until ActiveCell.Value = ""
artnr = ActiveCell.Value
Sheets(Blatt1).Activate
Range("A2").Select
b = False
Do Until ActiveCell.Value = "" Or artnr = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell.Value = artnr Then b = True
Sheets(Blatt2).Activate
If b = False Then ActiveCell.Interior.ColorIndex = 3
ActiveCell.Offset(1, 0).Select
Loop

End Sub

Jetzt wird allerdings nur eine abfrage auf die spalte "A" gemacht. Es wäre aber nicht schlecht, wenn das makro alle felder überprüfen würde, bei mir bis spalte "n".
ich habs schon ausprobiert, es würde gehen wenn ich hinter den ersten befehl, das gleiche nochmal mit "B2" wiederhole. Aber das ist glaube ich nicht optimal gelöst und auch nicht der sinn der sache.
hat da jemand ne andere idee?

• Ich komme nicht mehr in Folder Access HELFT MIR BITTE
• ADSL C2-010 Modem konfigurieren...
• Excel,Rang auch - Zahlen anzeigen