Thema Datum  Von Nutzer Rating
Antwort
05.01.2016 19:44:20 Peter
*****
Solved
06.01.2016 11:05:16 Gast86268
NotSolved
06.01.2016 11:22:58 Peter
NotSolved
06.01.2016 11:37:47 Gast48584
NotSolved
06.01.2016 11:49:16 Peter
NotSolved
06.01.2016 11:54:52 Gast60861
NotSolved
06.01.2016 12:11:53 Peter
NotSolved
07.01.2016 15:56:56 Gast81989
NotSolved
07.01.2016 18:34:32 Peter
NotSolved
07.01.2016 19:20:06 Gast11455
NotSolved
07.01.2016 19:28:59 Peter
NotSolved
07.01.2016 19:38:36 Gast26662
NotSolved
Rot Datenvergleich
08.01.2016 11:20:39 Gast94372
NotSolved
08.01.2016 19:50:42 Peter
NotSolved
08.01.2016 20:17:34 Gast58674
NotSolved
08.01.2016 20:57:07 Peter
NotSolved
09.01.2016 11:11:43 Gast57864
NotSolved
09.01.2016 12:23:51 Peter
NotSolved
09.01.2016 13:07:40 Gast36136
NotSolved

Ansicht des Beitrags:
Von:
Gast94372
Datum:
08.01.2016 11:20:39
Views:
1210
Rating: Antwort:
  Ja
Thema:
Datenvergleich

Hallo!

Also hier mal ein neuer Versuch. :-D Da es ja ein paar Spezialfälle gibt, musste ich da mal was festlegen. Also wenn in Blatt1 ein Eintrag mit Nr 123 ist und in Blatt2 zwei Einträge, wird der Eintrag mit den meisten Übereinstimmungen als alter Wert interpretiert und der zweite als neu eingefügte Zeile. Ähnlich wenn Blatt1 zwei Werte hat und Blatt 2 einen Wert. Auch hier gilt der Wert mit den meisten Übereinstimmungen als der richtige, der verglichen wird.

Wenn jeweils gleich viele Elemente vorkommen (2 in Blatt1 und Blatt2 bzw. 1 in Blatt1 und Blatt2) gehe ich davon aus, dass die Reihenfolge so ist, wie im Blatt eins. Die Werte im Blatt 2 haben also nicht die Zeile getauscht (letzte Frage von gestern, am Bsp. der Datumänderung).

Schaue mal bitte, ob das so wie gewünscht ist. Ansonsten können wir das auch noch ändern. Viele Grüße

 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Option Explicit
 
Sub vergleichen()
 
Dim ende As Long
Dim ende2 As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim anzahl1 As Long
Dim anzahl2 As Long
Dim zeile2 As Long
Dim zeile22 As Long
Dim eins As Object
Dim zwei As Object
Dim inhalt11
Dim inhalt12
Dim inhalt21
Dim inhalt22
Dim ident1 As Long
Dim ident2 As Long
 
Application.ScreenUpdating = False
 
Set eins = Worksheets(1)
Set zwei = Worksheets(2)
 
zwei.UsedRange.Interior.ColorIndex = xlNone
ende = eins.Cells(Rows.Count, 1).End(xlUp).Row
ende2 = zwei.Cells(Rows.Count, 1).End(xlUp).Row
 
For i = 1 To ende
     
    anzahl1 = Application.WorksheetFunction.CountIf(eins.Columns(1), eins.Cells(i, 1))
    anzahl2 = Application.WorksheetFunction.CountIf(zwei.Columns(1), eins.Cells(i, 1))
 
    Select Case anzahl1 & anzahl2
 
        Case 22, 11
            ' es wird davon ausgegangen, dass die Werte untereinanderstehen, nur inBlatt zwei wird gesucht
            zeile2 = Application.WorksheetFunction.Match(eins.Cells(i, 1), zwei.Columns(1), 0)
             
            For j = 1 To anzahl1
                 
                If j = 2 Then zeile2 = zeile2 + Application.WorksheetFunction.Match(eins.Cells(i + 1, 1), zwei.Range(zwei.Cells(zeile2 + 1, 1), zwei.Cells(ende2, 1)), 0)
             
                For k = 1 To 26
                    If zwei.Cells(zeile2, k) <> eins.Cells(i + j - 1, k) Then zwei.Cells(zeile2, k).Interior.ColorIndex = 6
                Next k
                 
                zwei.Cells(zeile2, 27) = "x"
                 
            Next j
             
        Case 21
            ' bei zwei zeilen in Blatt 1 und zwei in Blatt2 wird der Wert mit den meisten Übereinstimmunen genommen
         
            inhalt11 = eins.Range(eins.Cells(i, 1), eins.Cells(i, 26))
            inhalt12 = eins.Range(eins.Cells(i + 1, 1), eins.Cells(i + 1, 26))
            zeile2 = Application.WorksheetFunction.Match(eins.Cells(i, 1), zwei.Columns(1), 0)
            inhalt21 = zwei.Range(zwei.Cells(zeile2, 1), zwei.Cells(zeile2, 26))
             
            'prüfen wer die meisten Übereinstimmungen hat, der wird genommen
            ident1 = 0
            ident2 = 0
             
            For k = 1 To 26
                 If inhalt11(1, k) = inhalt21(1, k) Then ident1 = ident1 + 1
                 If inhalt12(1, k) = inhalt21(1, k) Then ident2 = ident2 + 1
            Next k
             
            j = 2
            If ident1 > ident2 Then j = 1
             
            For k = 1 To 26
                If zwei.Cells(zeile2, k) <> eins.Cells(i + j - 1, k) Then zwei.Cells(zeile2, k).Interior.ColorIndex = 6
            Next k
         
            zwei.Cells(zeile2, 27) = "x"
             
        Case 20, 10
            'da nix, wird am Ende gleb markiert
             
        Case 12
            inhalt11 = eins.Range(eins.Cells(i, 1), eins.Cells(i, 26))
            zeile2 = Application.WorksheetFunction.Match(eins.Cells(i, 1), zwei.Columns(1), 0)
            inhalt21 = zwei.Range(zwei.Cells(zeile2, 1), zwei.Cells(zeile2, 26))
            zeile22 = zeile2 + Application.WorksheetFunction.Match(eins.Cells(i, 1), zwei.Range(zwei.Cells(zeile2 + 1, 1), zwei.Cells(ende2, 1)), 0)
            inhalt22 = zwei.Range(zwei.Cells(zeile22, 1), zwei.Cells(zeile22, 26))
             
            ident1 = 0
            ident2 = 0
             
            For k = 1 To 26
                 If inhalt11(1, k) = inhalt21(1, k) Then ident1 = ident1 + 1
                 If inhalt11(1, k) = inhalt22(1, k) Then ident2 = ident2 + 1
            Next k
             
            
            If ident1 < ident2 Then zeile2 = zeile22
             
            For k = 1 To 26
                If zwei.Cells(zeile2, k) <> eins.Cells(i, k) Then zwei.Cells(zeile2, k).Interior.ColorIndex = 6
            Next k
             
            zwei.Cells(zeile2, 27) = "x"
             
        Case Else
 
    End Select
     
    i = i + anzahl1 - 1
     
Next i
 
For i = 1 To ende2
    If zwei.Cells(i, 27) <> "x" Then zwei.Range(zwei.Cells(i, 1), zwei.Cells(i, 26)).Interior.ColorIndex = 6
Next i
zwei.Columns("AA").ClearContents
 
Set eins = Nothing
Set zwei = Nothing
 
Application.ScreenUpdating = True
 
End Sub

 


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
05.01.2016 19:44:20 Peter
*****
Solved
06.01.2016 11:05:16 Gast86268
NotSolved
06.01.2016 11:22:58 Peter
NotSolved
06.01.2016 11:37:47 Gast48584
NotSolved
06.01.2016 11:49:16 Peter
NotSolved
06.01.2016 11:54:52 Gast60861
NotSolved
06.01.2016 12:11:53 Peter
NotSolved
07.01.2016 15:56:56 Gast81989
NotSolved
07.01.2016 18:34:32 Peter
NotSolved
07.01.2016 19:20:06 Gast11455
NotSolved
07.01.2016 19:28:59 Peter
NotSolved
07.01.2016 19:38:36 Gast26662
NotSolved
Rot Datenvergleich
08.01.2016 11:20:39 Gast94372
NotSolved
08.01.2016 19:50:42 Peter
NotSolved
08.01.2016 20:17:34 Gast58674
NotSolved
08.01.2016 20:57:07 Peter
NotSolved
09.01.2016 11:11:43 Gast57864
NotSolved
09.01.2016 12:23:51 Peter
NotSolved
09.01.2016 13:07:40 Gast36136
NotSolved