Office: Datenabgleich von zwei Dateien

Hallo,

ich suche nach einer Möglichkeit, identische Zellen in 2 Dateien so abzugleichen, dass sollte der Wert in Datei 1, Zelle A1 und Datei Zelle A1 nicht genau übereinstimmen, so wird die Zahl automatisch farbig.

Hintergrund:
Wir pflegen zu zweit in 2 identische Dateien die Umsätze ein.
Eine wird von mir bearbeitet und eine von meiner Kollegin.
Da es nicht ausgeschlossen ist, dass man mal in der Zeile verrutscht oder einen Zahlendreher hat, sollte sofort nach Eingabe, wenn die Eingabe identisch ist, die Zahl schwarz bleiben und sollte die Eingabe nicht identisch sein, die Zahl z.B. rot werden.

So wäre es für uns gewährleistet, dass die Endsummen 100 %ig stimmen.

Die eingaben erfolgen immer in die gleichen Zellen, also wenn ich in A1 schreibe, schreibt meine Kollegin auch in A1 usw.

Gibt es hierfür eine Lösung?

Vielen Dank!
Petra

 

Hallo!

Wenn es zwei Dateien sind, dann wirst du wohl um VBA nicht herumkommen...
Wenn es allerdings zwei Blätter innerhalb der selben Datei sind, dann ließe sich sicher etwas mit der "Bedingten Formatierung" machen. Diese findest du im Menü "Format" und sie sollte für deine Zwecke ziemlich selbsterklärend sein.
Falls nicht, dann weißt du ja, wo du spezieller nachfragen könntest... :-D

 

Hallo Schatzi,

das mit der Bedingten Formatierung kenne ich aber ich weiß auch, dass das nicht klappt wenn es sich um 2 Dateien handelt.

Kannst Du mir, oder jemand bei dem VBA helfen?
Weil ich bring das nicht hin :-?

Danke schon mal....

Petra

 

Hallo Petra,

ich habe Dir ein VBA-Makro gestrickt, das hoffentlich Dein Problem löst.

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Bereich As Range, ExtBereich As Range
  Dim Wb As Workbook
  Dim Pfad$(), ExtFormel$, ExtDatei$, ExtBlatt$
  Dim Zl%, Sp%, Zelle As Range, Zl1%
  On Error GoTo Err_SheetBefDblClick
'--- In "Sh" ist das Sheet der eigenen Excel-Datei enthalten
'--- In "Target" ist die Zelle enthalten, die den Zellbezug
'    auf die Zelle A1 des Arbeitsblattes der externen Excel-Datei enthält
  Set Bereich = Sh.Range("A1").CurrentRegion
'--- Formel auf externe Zelle hat folg.Syntax: ='I:\EXCEL\[DoppelKlick.xlsm]Master'!A1
  ExtFormel$ = Target.Formula     'Hole Formel auf externe Zelle A1
  ExtDatei$ = Mid$(ExtFormel$, 3) 'Entferne ='
  Pfad$ = Split(ExtDatei$, "]")
  ExtDatei$ = Replace(Pfad$(0), "[", "") 'I:\EXCEL\DoppelKlick.xslm
  Pfad$ = Split(Pfad$(1), "!")
  ExtBlatt$ = Replace(Pfad$(0), "'", "") 'Master
  
  Set Wb = Workbooks.Open(ExtDatei$)
  Set ExtBereich = Wb.Sheets(ExtBlatt$).Range(Pfad$(1)).CurrentRegion
  
'--- Beide Bereiche Zelle für Zelle vergleichen und einfärben
'    Aktive Zelle zeilenweise mitverschieben
  Sh.Activate
  Zl1% = 0
  For Each Zelle In Bereich.Cells
    Zl% = Zelle.Row: Sp% = Zelle.Column
    If Zl% <Zl1> Keine Aktion
    Else
      'Inhalte der Vergleichszellen sind verschieden
       Zelle.Font.Color = RGB(255, 0, 0) 'rot
    End If
    Zl1% = Zl%
  Next Zelle
  Exit Sub
Err_SheetBefDblClick:
  MsgBox "Es ist folgender Fehler Nr." & Err.Number & " aufgetreten: " & vbCrLf & Err.Description
End Sub

1) Dieses Makro mit der Maus selektieren, Tasten Strg+C drücken, um es in die Zwischenablage zu kopieren

2) In Dein Excel-Arbeitsblatt (mit Deinen Daten) wechseln, die Tasten Alt+F11 drücken, um in den VBA-Editor zu gelangen, zur Sicherheit die Tasten Strg+R drücken, um das Fenster mit dem VBA-Projekt anzuzeigen, dort auf den Eintrag 'DieseArbeitsmappe' einen Doppelklick ausführen, im sich öffnenden Codefenster (für die Klasse Arbeitsmappe) die Tasten Strg+V drücken, um den VBA-Code einzufügen.

3) Wieder zurück ins Arbeitsblatt wechseln,
dort eine Zelle wählen, die ringsum durch Leerzellen von Deinen zu testenden Daten getrennt ist. In diese Zelle eine Formel eingeben, die sich auf eine Zelle in der zu vergleichenden externen Exceldatei bezieht - nach folgendem Musterbeispiel:
='I:\Excel\[DoppelKlick.xlsm]Master'!A1
Bei diesem Musterbeispiel handelt es sich um die Exceldatei "DoppelKlick.xlsm", die sich im Verzeichnis "I:\Excel" befindet. In dieser Exceldatei gibt es das Arbeitsblatt "Master", in dem sich ab Zelle A1 die Vergleichsdaten befinden. Bitte die eigenwillige Syntax (insbesondere die eckigen Klammen, die einfachen Hochkommas, das Ausrufezeichen) genau einhalten - es müsste daraufhin exakt der Inhalt der ersten Vergleichszelle der externen Exceldatei erscheinen (diese muss dazu keinesfalls geöffnet sein!).

4) Erscheint der Zellinhalt wie gewünscht, genau auf diese Zelle einen Doppelklick ausführen und der Vergleichsvorgang startet, indem die externe Exceldatei geöffnet wird und die Daten Deines Arbeitsblattes ab Zelle A1 Zelle für Zelle mit den Daten der anderen Exceldatei verglichen werden. Abweichende Daten werden rot eingefärbt.
Um den Fortschritt des Vergleichens mitverfolgen zu können, läuft die aktive Zelle Zeile für Zeile mit.

 

Hallo Petra,

ich musste leider feststellen, dass das Uploaden des Codes in diesem Forum offenbar fehlerhaft ist. Ich füge den VBA-Code noch einmal an, diesmal nicht als Code formatiert:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Bereich As Range, ExtBereich As Range
Dim Wb As Workbook
Dim Pfad$(), ExtFormel$, ExtDatei$, ExtBlatt$
Dim Zl%, Sp%, Zelle As Range, Zl1%
On Error GoTo Err_SheetBefDblClick
'--- In "Sh" ist das Sheet der eigenen Excel-Datei enthalten
'--- In "Target" ist die Zelle enthalten, die den Zellbezug
' auf die Zelle A1 des Arbeitsblattes der externen Excel-Datei enthält
Set Bereich = Sh.Range("A1").CurrentRegion
'--- Formel auf externe Zelle hat folg.Syntax: ='I:\EXCEL\[DoppelKlick.xlsm]Master'!A1
ExtFormel$ = Target.Formula 'Hole Formel auf externe Zelle A1
ExtDatei$ = Mid$(ExtFormel$, 3) 'Entferne ='
Pfad$ = Split(ExtDatei$, "]")
ExtDatei$ = Replace(Pfad$(0), "[", "") 'I:\EXCEL\DoppelKlick.xslm
Pfad$ = Split(Pfad$(1), "!")
ExtBlatt$ = Replace(Pfad$(0), "'", "") 'Master

Set Wb = Workbooks.Open(ExtDatei$)
Set ExtBereich = Wb.Sheets(ExtBlatt$).Range(Pfad$(1)).CurrentRegion

'--- Beide Bereiche Zelle für Zelle vergleichen und einfärben
' Aktive Zelle zeilenweise mitverschieben
Sh.Activate
Zl1 = 0
For Each Zelle In Bereich.Cells
Zl = Zelle.Row: Sp = Zelle.Column
'
If Zl <> Zl1 Then Zelle.Select
If Zelle.Value = ExtBereich(Zl, Sp).Value Then
'
Else
'Inhalte der Vergleichszellen sind verschieden
Zelle.Font.Color = RGB(255, 0, 0) 'rot
End If
Zl1 = Zl
Next Zelle
Exit Sub
Err_SheetBefDblClick:
MsgBox "Es ist folgender Fehler Nr." & Err.Number & " aufgetreten: " & vbCrLf & Err.Description
End Sub

Die Codepassage, wo die Vergleiche ausgeführt werden, wurde nämlich fehlerhaft wiedergegeben.
Tut mir leid - aber nicht meine Schuld.
Bitte die beiden Stellen mit und entfernen, nur mit diesem Trick konnte ich den Code korrekt uploaden.

 

Hallo, hier ist bin ich wieder "Chaos-Knuddl" ... :-)

Ich denke, dass ich alles gemacht habe wie beschrieben, es funktioniert aber nicht.

Kannst Du Dich meiner nochmals annehmen?

Ich geb Dir nun mal folgende Daten, die ja in den Code eingefügt werden sollten, vielleicht liegt hier der Fehler.

Ort der Datei: F:\meyer\VK Statistik Originale\2010

Dateiname: C_GS 101_2010.xls

ist abzugleichen mit

P_GS 101_2010.xls (Dateiort ist der gleiche)

Jeweil identisch in beiden Dateien ist das abzugleichende Arbeitsblatt "Auswertung Kunden" und die

Zellen H7 - H6000
Zellen I7 - I6000
Zellen J7 - J6000
Zellen K7 - K6000

Vielen, vielen Dank!
Knuddl

 

Hallo Knuddl,

die Formel, die in die Zelle einzufügen ist, auf die dann ein Doppelklick zu machen ist (zB. Zelle A1), muss nach meiner Beispielbeschreibung und Deinen obigen Angaben lauten:
='F:\meyer\VK Statistik Originale\2010\[P_GS_101_2010.xls]Auswertung Kunden'!H7
Die Zelle (in diesem Fall H7) muss in dem Bereich (H7:K6000) der Vergleichsdatei enthalten sein.
Ferner gab es in meinem Makro ein weiteres Problem, da ich davon ausging, dass der Zellbereich jedesmal in A1 beginnt und nicht in H7. Diese Änderung habe ich im folgenden Makro jetzt berücksichtigt. Um dem Makro mitzuteilen, wo der Zellbereich im aktuellen Arbeitsblatt liegt, in die Zelle unterhalb obiger Formel (also zB. A2) folgende Formel eingeben:
=H7
Dadurch weiß das Makro, wo beide zu vergleichenden Zellbereiche liegen (nämlich in den zusammenhängenden Zellbereichen, in dem beide Zellen H7 liegen).

Zum Starten des Makros bitte wieder auf die 1. der beiden Zellen (zB. A1) einen Doppelklick machen.

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Bereich As Range, ExtBereich As Range
  Dim Wb As Workbook
  Dim Pfad$(), ExtFormel$, ExtDatei$, ExtBlatt$
  Dim Zl%, Sp%, Zelle As Range, Zl1%, ZlO%, SpO%
  On Error GoTo Err_SheetBefDblClick
'--- In "Sh" ist das Sheet der eigenen Excel-Datei enthalten
  If Left$(Target.Value, 1) <> "=" Then Exit Sub
  If Left$(Target.Offset(1,0).value,1) <> "=" Then Exit Sub
'--- In Target.Offset(1,0) ist die Zelle enthalten, den den Zellbezug
'    auf eine Zelle des Vergleichsbereichs des aktuellen Arbeitsblattes enthält.
  ExtFormel$ = Mid$(Target.Offset(1, 0).Formula, 2)
  Set Bereich = Sh.Range(ExtFormel$).CurrentRegion
  ZlO% = Bereich.Row - 1
  SpO% = Bereich.Column - 1
'--- In "Target" ist die Zelle enthalten, die den Zellbezug
'    auf eine Zelle des Vergleichsbereichs des Arbeitsblattes der externen Excel-Datei enthält
'--- Formel auf externe Zelle hat folg.Syntax: ='I:\EXCEL\[DoppelKlick.xlsm]Master'!A1
  ExtFormel$ = Target.Formula     'Hole Formel auf externe Zelle A1
  ExtDatei$ = Mid$(ExtFormel$, 3) 'Entferne ='
  Pfad$ = Split(ExtDatei$, "]")
  ExtDatei$ = Replace(Pfad$(0), "[", "") 'I:\EXCEL\DoppelKlick.xslm
  Pfad$ = Split(Pfad$(1), "!")
  ExtBlatt$ = Replace(Pfad$(0), "'", "") 'Master
  
  Set Wb = Workbooks.Open(ExtDatei$)
  Set ExtBereich = Wb.Sheets(ExtBlatt$).Range(Pfad$(1)).CurrentRegion
'
'--- Beide Bereiche Zelle für Zelle vergleichen und einfärben
'    Aktive Zelle zeilenweise mitverschieben
  Sh.Activate
  Zl1% = 0
  For Each Zelle In Bereich.Cells
    Zl% = Zelle.Row: Sp% = Zelle.Column
    If Zl% <> Zl1% Then Zelle.Select
    If Zelle.Value = ExtBereich(Zl% - ZlO%, Sp% - SpO%).Value Then
      'Inhalte der Vergleichszellen sind gleich
    Else
      'Inhalte der Vergleichszellen sind verschieden
       Zelle.Font.Color = RGB(255, 0, 0) 'rot
    End If
    Zl1% = Zl%
  Next Zelle
  Exit Sub
Err_SheetBefDblClick:
  MsgBox "Es ist folgender Fehler Nr." & Err.Number & " aufgetreten: " & vbCrLf & Err.Description
End Sub

 

funktioniert nicht...

Habe, denk ich mal, alles wie beschrieben gemacht.

Makro in C_GS 101_2010 - "DieseArbeitsmappe" eingefügt.

Eine Zelle gewählt, die ringsum durch Leerzellen von meinen Daten getrennt ist. Habe CE1 genommen und die Formel

='F:\meyer\VK Statistik Originale\2010\[P_GS 101_2010.xls]Auswertung Kunden'!H7

eingegeben.

Nun zeigt es mir in dieser Zelle CE1 die Zahl die in der Zelle H7 in der anderen Datei P_GS 101_2010 steht.

Nun habe ich noch in die Zelle unter der mit der Formel, also in CE2 =H7 eingegenben.

Ich habe bei den zu vergleichenden Zellen (H7) in beiden Dateien einmal identische und einmal unterschiedliche Werte eingegeben, die Zahl wird aber in beiden Fällen nicht rot.

Was hab ich falsch gemacht?

Danke Petra

 

Hallo Knuddl,

kannst Du mir verzeihen? Ich habe leider eine Sicherheitsabfrage, die dazu dient, dass man nicht an der falschen Stelle das Doppelklickmakro ausführen kann, zu allerletzt noch eingefügt, ohne sie jedoch zu testen - und habe dabei statt der Formula-Eigenschaft die Value-Eigenschaft der Zelle verwendet.

Die Formeln in CE1 und CE2 müssten ok sein - Start des Makro durch Doppelklick auf CE1.

Sind die beiden Bereiche H7:K6000 von lauter Leerzellen umgeben? Falls nicht, wird der jeweils größere Bereich zum Vergleich herzangezogen, wobei die Größe durch den Bereich im aktuellen Arbeitsblatt festgelegt wird. Notfalls könnte ich dann noch den Bereich H7:K6000 als fixen Vergleichsbereich vorgeben.

Nachfolgend noch einmal das hoffentlich korrekte Makro:

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Bereich As Range, ExtBereich As Range
  Dim Wb As Workbook
  Dim Pfad$(), ExtFormel$, ExtDatei$, ExtBlatt$
  Dim Zl%, Sp%, Zelle As Range, Zl1%, ZlO%, SpO%
  On Error GoTo Err_SheetBefDblClick
'--- In "Sh" ist das Sheet der eigenen Excel-Datei enthalten
  If Left$(Target.Formula, 1) <> "=" Then Exit Sub
  If Left$(Target.Offset(1, 0).Formula, 1) <> "=" Then Exit Sub
'--- In Target.Offset(1,0) ist die Zelle enthalten, den den Zellbezug
'    auf eine Zelle des Vergleichsbereichs des aktuellen Arbeitsblattes enthält.
  ExtFormel$ = Mid$(Target.Offset(1, 0).Formula, 2)
  Set Bereich = Sh.Range(ExtFormel$).CurrentRegion
  ZlO% = Bereich.Row - 1
  SpO% = Bereich.Column - 1
'--- In "Target" ist die Zelle enthalten, die den Zellbezug
'    auf eine Zelle des Vergleichsbereichs des Arbeitsblattes der externen Excel-Datei enthält
'--- Formel auf externe Zelle hat folg.Syntax: ='I:\EXCEL\[DoppelKlick.xlsm]Master'!A1
  ExtFormel$ = Target.Formula     'Hole Formel auf externe Zelle A1
  ExtDatei$ = Mid$(ExtFormel$, 3) 'Entferne ='
  Pfad$ = Split(ExtDatei$, "]")
  ExtDatei$ = Replace(Pfad$(0), "[", "") 'I:\EXCEL\DoppelKlick.xslm
  Pfad$ = Split(Pfad$(1), "!")
  ExtBlatt$ = Replace(Pfad$(0), "'", "") 'Master
  
  Set Wb = Workbooks.Open(ExtDatei$)
  Set ExtBereich = Wb.Sheets(ExtBlatt$).Range(Pfad$(1)).CurrentRegion
'
'--- Beide Bereiche Zelle für Zelle vergleichen und einfärben
'    Aktive Zelle zeilenweise mitverschieben
  Sh.Activate
  Zl1% = 0
  For Each Zelle In Bereich.Cells
    Zl% = Zelle.Row: Sp% = Zelle.Column
    If Zl% <> Zl1% Then Zelle.Select
    If Zelle.Value = ExtBereich(Zl% - ZlO%, Sp% - SpO%).Value Then
      'Inhalte der Vergleichszellen sind gleich
    Else
      'Inhalte der Vergleichszellen sind verschieden
       Zelle.Font.Color = RGB(255, 0, 0) 'rot
    End If
    Zl1% = Zl%
  Next Zelle
  Exit Sub
Err_SheetBefDblClick:
  MsgBox "Es ist folgender Fehler Nr." & Err.Number & " aufgetreten: " & vbCrLf & Err.Description
End Sub

 

.... klar verzeih ich Dir, wenn Du mir versprichst, dass Du mir hilfst bis das alles so funktioniert wie ich es gerne möchte... :-D

Weil: Es geht immer noch nicht.

Ist es richtig, dass ich den Code in "DieseArbeitsmappe" einfüge?

Nein, im Bereich H7 - H6000 stehen duchgehend Auftragsnummern drin und in I7 - I6000 werden noch Werte eingegeben, betrifft beide Dateien.

Knuddl

 

Hallo Knuddl,

ich habe jetzt das Makro so abgewandelt, dass es im aktuellen Arbeitsblatt von einem vorgebbaren Bereich ausgeht:
in Zelle CE2 steht die Formel, die den Inhalt der linken oberen Ecke anzeigt (also: =H7)
in der Zelle daneben, also in CF2 steht die Formel, die den Inhalt der rechten unteren Ecke anzeigt (also: =K6000)
in der Zeile darüber, also in CE1 steht wie gehabt die Formel, die den Inhalt der linken oberen Ecke des zu vergleichenden Bereiches der externen Excel-Datei (also: ='F:\meyer\VK Statistik Originale\2010\[P_GS 101_2010.xls]Auswertung Kunden'!H7 ) angibt;
Die Größe des zu vergleichenden externen Bereiches richtet sich nach der Größe des Bereiches im aktuellen Arbeitsblatt - daher braucht in Zelle CF1 für die rechte untere Ecke des externen Bereiches auch nichts stehen.
Es wird aufgrund obiger Vorgaben jeweils in beiden Arbeitsblättern der Bereich H7:K6000 miteinander verglichen

Ich habe deshalb für die Codespeicherung 'DieseArbeitsmappe' gewählt, weil man damit mit ein und demselben Code die Inhalte anderer Arbeitsblätter der aktuellen Arbeitsmappe auch mit der externen Datei vergleichen könnte. Falls Du eine englische Excel-Version haben solltest, steht dort 'ThisWorkbook'. Verlegt man das Makro in den Codespeicher eines Arbeitsblattes, müsste auch der Makrokopf etwas abgewandelt werden in: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean). Die Unterschiede liegen im verschiedenen Präfix des Prozedurnamens (Worksheet_ statt Workbook_) und natürlich im fehlenden Parameter ByVal Sh As Object für das aktuelle Arbeitsblatt.

Durch Doppelklick auf die Zelle CE1 müsste das Makro wieder zu starten sein:
a) daraufhin öffnet das Makro ebenfalls die externe Excel-Datei F:\meyer\VK Statistik Originale\2010\P_GS 101_2010.xls
b) vergleicht jeweils im Bereich H7:K6000 Zelle für Zelle die Inhalte miteinander: bei Inhaltsverschiedenheit wird der Zelltext im aktuellen Arbeitsblatt rot eingefärbt, bei Gleichheit wird nichts gemacht.
c) Um den Vergleichsfortschritt anzuzeigen, läuft die aktive Zelle im Bereich H7:H6000 des aktuellen Arbeitsblattes Zeile für Zeile mit.
d) nach Abschluss der Vergleicherei wird die externe Excel-Datei wieder geschlossen.

Code:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
  Dim Bereich As Range, ExtBereich As Range
  Dim Wb As Workbook
  Dim Pfad$(), AktFormel$, ExtFormel$, ExtDatei$, ExtBlatt$
  Dim Zl%, Sp%, Zelle As Range, Zl1%, ZlO%, SpO%
  On Error GoTo Err_SheetBefDblClick
'--- In "Sh" ist das Sheet der eigenen Excel-Datei enthalten
  If Left$(Target.Formula, 1) <> "=" Then Exit Sub
  If Left$(Target.Offset(1, 0).Formula, 1) <> "=" Then Exit Sub
'--- In Target.Offset(1,0) ist die Zelle enthalten, den den Zellbezug
'    auf die linke obere Ecke des Vergleichsbereichs des aktuellen Arbeitsblattes enthält.
'--- In Target.Offset(1,1) steht die rechte untere Ecke
  AktFormel$ = Mid$(Target.Offset(1, 0).Formula, 2) & ":" & Mid$(Target.Offset(1, 1).Formula, 2)
  Set Bereich = Sh.Range(AktFormel$)
  ZlO% = Bereich.Row - 1
  SpO% = Bereich.Column - 1
'--- In "Target" ist die Zelle enthalten, die den Zellbezug
'    auf die linke obere Ecke des Vergleichsbereichs des Arbeitsblattes der externen Excel-Datei enthält
'--- Formel auf externe Zelle hat folg.Syntax: ='I:\EXCEL\[DoppelKlick.xlsm]Master'!A1
  ExtFormel$ = Target.Formula     'Hole Formel auf externe Zelle A1
  ExtDatei$ = Mid$(ExtFormel$, 3) 'Entferne ='
  Pfad$ = Split(ExtDatei$, "]")
  ExtDatei$ = Replace(Pfad$(0), "[", "") 'I:\EXCEL\DoppelKlick.xslm
  Pfad$ = Split(Pfad$(1), "!")
  ExtBlatt$ = Replace(Pfad$(0), "'", "") 'Master
  
  Set Wb = Workbooks.Open(ExtDatei$)
  Set ExtBereich = Wb.Sheets(ExtBlatt$).Range(Pfad$(1))
'
'--- Beide Bereiche Zelle für Zelle vergleichen und einfärben
'    Aktive Zelle zeilenweise mitverschieben
  Sh.Activate
  Zl1% = 0
  For Each Zelle In Bereich.Cells
    Zl% = Zelle.Row: Sp% = Zelle.Column
    If Zl% <> Zl1% Then Zelle.Select
    If Zelle.Value = ExtBereich(Zl% - ZlO%, Sp% - SpO%).Value Then
      'Inhalte der Vergleichszellen sind gleich
    Else
      'Inhalte der Vergleichszellen sind verschieden
       Zelle.Font.Color = RGB(255, 0, 0) 'rot
    End If
    Zl1% = Zl%
  Next Zelle
  Wb.Close
  Exit Sub
Err_SheetBefDblClick:
  MsgBox "Es ist folgender Fehler Nr." & Err.Number & " aufgetreten: " & vbCrLf & Err.Description
End Sub

 

Oh man, hab ein Problem mit meinem Zugang gehabt, aber jetzt bin ich wieder da. Bin nu Knuddl62

Also, ich hab das alles so gemacht, wie Du es beschrieben hast.

Habe Werte (gleiche und ungleiche) in die Spalte H eingegenben.

Habe Doppelklick auf Zelle CE1 gemacht und es hat gearbeitet und mir die nichtidentischen auch rot gemacht.

In Zelle H7 waren die Werte nicht identisch, es wurde rot, hab jetzt in dieser Zelle die Werte identisch gemacht, es bleibt trotzdem rot.

Wollte das Makro duch Doppelklick wieder aktivieren, es kommt dann die Meldung Fehler 1004. Datei P_GS 101_2010.xls wurde nicht gefunden.

Die vorher eingegebene Formel in CE1 hat sich von

='F:\meyer\VK Statistik Originale\2010\[P_GS 101_2010.xls]Auswertung Kunden'!H7

in ='[P_GS 101_2010.xls]Auswertung Kunden'!H7

verwandelt

'F:\meyer\VK Statistik Originale\2010\ felht, einfach weg.

Noch ne generelle Frage zu meinen Dateien.
Beide Dateien werden ja von mir und meiner Kolleginn mit den selben Werten, es soll den Hintergrund haben, dass Fehler und Zahlendreher sofort bei Eingabe, durch Rotfärbung der Eingabe erkannt werden, geht das mit diesem Makro, so wie wir das nun gemacht haben?

Knuddl

 

Hallo Knuddl,

1) jedesmal wenn das Makro gestartet wird, wird ein Vergleich der jeweils entsprechenden Zellen der beiden Excel-Dateien durchgeführt. Damit das Makro weiß, welche Zellen es vergleichen soll und wie groß der Vergleichsbereich ist, dienen dazu die 3 Formeln in Zelle CE1, CE2 und CF2. Diese Formeln werden vom Makro in ihre Bestandteile zerlegt, um die nötige Information über Ort und Größe der Vergleichsobjekte zu erhalten und zwar:
a) Formel in CE1: ='F:\meyer\VK Statistik Originale\2010\[P_GS 101_2010.xls]Auswertung Kunden'!H7 wird zerlegt, sodass F:\meyer\VK Statistik Originale\2010\ den Pfad auf die externe Datei liefert, P_GS 101_2010.xls den Dateinamen, Auswertung Kunden das Arbeitsblatt und H7 die linke obere Zelle des externen Vergleichsbereiches;
b) Formel in CE2: =H7 wird verwendet, um mit H7 die linke obere Ecke des Vergleichsbereiches im aktuellen Arbeitsblatt zu erhalten;
c) Formel in CF2: =K6000 wird verwendet, umt mit K6000 die rechte untere Ecke des Vergleichsbereiches im aktuellen Arbeitsblatt zu erhalten.
d) Aufgrund der Information aus b)+c) ist somit auch die Größe der Vergleichsbereiche sowohl im aktuellen Arbeitsblatt als auch in der externen Excel-Datei eindeutig klar.

2) So wie das Makro momentan funktioniert, wird eine Rotfärbung bei Zellinhaltsverschiedenheit durchgeführt, bei Inhaltsgleichheit wird keine Aktion veranlasst (vgl. Punkt b) in meinem letzten Schreiben). Ich kann natürlich ins Makro eine Schwarzfärbung bei Zellgleichheit einbauen:
Dazu braucht man nur die Makrozeile Zelle.Font.Color = RGB(255, 0, 0) 'rot kopieren
und 2 Zeilen darüber (oberhalb des 'Else') einfügen und statt RGB(255,0,0) einfach eine 0 (Null) verwenden (das Wort 'rot ist Kommentar und kann durch 'schwarz ersetzt werden, jedoch darf der Apostroph nicht entfernt werden, er kennzeichnet den Beginn des Kommentars in der Zeile).

3) a) Das Makro installiert keinesfalls so etwas wie eine bedingte Formatierung, denn eine solche funktioniert leider nur innerhalb ein und desselben Arbeitsblattes und nicht zwischen 2 verschiedenen Arbeitsblättern, geschweige denn zwischen 2 Dateien. Damit kann Deine letzte Frage eindeutig mit nein beantwortet werden.
b) Wenn statt eines einmaligen Testlaufes durch ein Makro vielmehr Folgendes gewünscht wird:
- die Daten der externen Excel-Datei sind bereits in den Bereich H7:K6000 eingegeben (von der Kollegin und die Datei ist gespeichert),
- die Daten im aktuellen Arbeitsblatt sind noch in den Bereich H7:K6000 einzugeben;
- diese beiden Datenbereiche in H7:K6000 sind in ihrer Größe konstant;
- es soll laufend mitkontrolliert werden können, ob die Daten Zelle für Zelle exakt übereinstimmen,
- dann kann man das auch mit einer sogenannten Matrixformel lösen:
Du brauchst dazu in Deiner Arbeitsmappe, am besten in Deinem aktuellen Arbeitsblatt einen Zellbereich, der genau so groß wie der Bereich H7:K6000 ist und der noch leer ist: diesen Zellbereich markierst Du und gibst in die Formeleditierzeile folgende Formel ein:
=N(H7:K6000='F:\meyer\VK Statistik Originale\2010\[P_GS 101_2010.xls]Auswertung Kunden'!H7:K6000)
beendest aber die Formeleingabe nicht mit der einfachen Eingabe-Taste, sondern mit der Tastenkombination Strg+Umschalt+Eingabe.
Daraufhin wird die eingegebene Formel in geschweiften Klammern eingeschlossen angezeigt.
Gibst Du zB. in Zelle H7 einen Wert ein, der gleich dem Wert der Zelle H7 in der externen Datei ist, erscheint in dem Formelbereich die entsprechende Zelle mit einem 1-Wert; weichen die beiden Werte voneinander ab, erscheint dagegen ein '0'-Wert.
Gibst Du obige Formel in ein anderes Arbeitsblatt Deiner aktuellen Excel-Datei ein, musst Du
statt '=N(H7:K6000...' natürlich '=N(Blattname!H7:K6000...' eingeben.
Um sofort zu sehen, wo die Hunde sitzen, kannst Du den Bereich der Matrixformel auch noch speziell formatieren, indem Du folgendes benutzerdefinierte Zahlenformat eingibst für den ganzen Bereich: ;;"NEIN"
(Die beiden Strichpunkte und die Anführungszeichen sind exakt so einzugeben, statt NEIN kannst Du Dein Lieblingswort wählen) - Überall wo ein NEIN steht im Formelbereich, dort ist im Dateneingabebereich ein Fehler enthalten.
Das Ganze zuerst einmal mit einem kleinen Bereich ausprobieren, bevor es mit dem großen Bereich H7:K6000 realisiert wird.

4) a) Solange die externe Excel-Datei geschlossen ist (also nicht ins aktuelle Objektsystem von Excel integriert ist), sieht die Formel in CE1 so aus: ='F:\meyer\VK Statistik Originale\2010\[P_GS 101_2010.xls]Auswertung Kunden'!H7.
b) Sobald das Makro gestartet wurde, wird die externe Excel-Datei geöffnet (d.h. mit ihren Bestandteilen ins Objektsystem von Excel integriert), dann sieht die Formel in CE1 so aus: ='[P_GS 101_2010.xls]Auswertung Kunden'!H7
c) Daraufhin werden die Zellen in den beiden Bereichen miteinander verglichen und bei Inhaltsverschiedenheit die Schrift der Zelle im aktuellen Arbeitsblatt rot gefärbt, bei Gleichheit wurde bisher einfach gar nichts gemacht, mit der zusätzlichen Programmzeile aus Punkt 2) wird der Text schwarz gefärbt.
d) Wenn alle Zellen der Vergleichsbereiche miteinander verglichen sind, wird die bis jetzt geöffnete externe Datei wieder geschlossen (d.h. aus dem Objektsystem von Excel wieder entfernt) und dann hat die Formel aus Zelle CE1 wieder ihre ursprüngliche Gestalt (d.h. es ist der Pfad auf die Datei wieder in der Formel enthalten).

5) Wird das Makro unterbrochen oder abgebrochen, bevor es den Punkt 4d) ausgeführt hat, bleibt die externe Excel-Datei natürlich weiterhin geöffnet.
Da die Vergleichsbereiche doch eine ansehnliche Größe haben ((6000-6)*4=23976 Zellen, die miteinander verglichen werden), dauert natürlich die Ausführung des Makros einige Zeit. Um über den momentanen Fortgang des Makros informiert zu sein, habe ich eingebaut, dass die aktive Zelle Zeile für Zeile mitläuft und dadurch wird auch das Arbeitsfenster von Excel automatisch mitgescrollt.

Ich hoffe aufgrund Deines letzten Schreibens, dass eventuell der Vorschlag aus Punkt 3b) weiterhilft.

 

Hallo Exl121150,

vielen, vielen Dank für Deine Hilfe und Deine Ausdauer.

Wie Du geschrieben hast, ist 3b die beste Lösung für mein Anliegen.

Es funktiomiert einwandfrei und ist mir im täglichen Umgang mit diesen Dateien eine große Hilfe!

ECHT SUPER!!!!!!!!!!!! :-D :-D :-D :-D :-D :-D

Es ist gut zu wissen, wo Leute sitzen die auch einem Anwender mit Grundkentnissen so geduldig weiterhelfen und nach Lösungen suchen.

Danke und vielleicht bis demnächst, wenn mir wieder was einfällt was man machen könnte ich aber nicht weiß, WIE!!!!!

Grüßle
Petra