2 Excel Sheets vergleichen und in eine 3te schreiben :: Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office

Einloggen, um private Nachrichten zu lesen

Downloads

[Excel 2003] 2 Excel Sheets vergleichen und in eine 3te schreiben

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Autor

Nachricht

xyba
Newbie
Newbie

Anmeldedatum: 23.01.2008
Beiträge: 1

Verfasst am: 23.01.2008, 13:56

Hallo Leute!

Habe da ein kleines Problem ich möchte 2 excel sheets mit 11 tabellen und ca. 500 einträgen vergleichen.

Das Problem ist das Script funktioniert soweit nur er schreib mit in die 3te Tabelle nur die gelöschten rein aber die was unterschiedlich von den inserts sind nicht.

Hoffe ihr könnt mir helfen anbei der Code

Code:

Option Explicit
Sub Master()

Dim i As Integer

' Hier die Anzahl der Spalten eingegben (z.B.: 3):
For i = 1 To 11
Call Vergleich(i)
Next

End Sub

Function Vergleich(akspa As Integer)
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim dopp(5000) As Integer
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer
Dim v, vv As Integer
Dim w, ww As Integer

z = 4
Do While Worksheets("Gesamt").Cells(z, akspa) <> ""
verg1(z) = Worksheets("Gesamt").Cells(z, akspa)
z = z + 1
Loop
' Werte aus Tabelle 2 einlesen
y = 4
Do While Worksheets("Gesamt2").Cells(y, akspa) <> ""
verg2(y) = Worksheets("Gesamt2").Cells(y, akspa)
y = y + 1
Loop
' Werte vergleichen
r = 1
s = 1
For r = 1 To z - 1
For s = 1 To y - 1
' Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja"
If verg2(s) = verg1(r) Then merk2(s) = "ja"
If verg1(r) = verg2(s) Then
dopp(r) = 1
'Cells(s, akspa) = ""
End If

Next s
Next r
' Ungleiche Werte aus Tabelle 1 ausgeben
t = 1
For t = 1 To r
If merk1(t) <> "ja" Then
tt = tt + 1
Worksheets("Gesamt2").Select
Worksheets("Gesamt2").Rows(t).Copy
Worksheets("Prüfung").Select
'Worksheets("Prüfung").Cells(tt, 1) = verg1(t)
Worksheets("Prüfung").Cells(tt, 1).Select
ActiveSheet.Paste
End If
Next t

' Ungleiche Werte aus Tabelle 2 ausgeben
v = 1
For v = 1 To s
If merk2(v) <> "ja" Then
vv = vv + 1
Worksheets("Gesamt2").Select
Worksheets("Gesamt2").Rows(v).Copy
Worksheets("Prüfung").Select
'Worksheets("Prüfung").Cells(vv, 1) = verg2(v)
Worksheets("Prüfung").Cells(vv, 1).Select
ActiveSheet.Paste
End If
Next v

' Inhalte vergleichen ausgeben
w = 1
For w = 1 To s
If dopp(w) = 0 Then
ww = ww + 1
Worksheets("Gesamt2").Select
Worksheets("Gesamt2").Rows(w).Copy
Worksheets("Prüfung").Select
Worksheets("Prüfung").Cells(ww, 1).Select
ActiveSheet.Paste
End If
Next w
Application.CutCopyMode = False
'Cells.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
End Function

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Thema		Autor	Forum	Antworten	Verfasst am
Ähnliche Beiträge
	Excel rechnet nicht immer richtig	gausle	Microsoft Excel Hilfe	1	08.01.2009, 19:29
	Weiterbildung/Schulung in Excel	matze63	Microsoft Excel Hilfe	0	08.01.2009, 16:41
	excel formel mit und/oder	3höckerkamel	Microsoft Excel Hilfe	1	07.01.2009, 15:43
	Hallo Leute, eine Formel für Prozente	willi1412	Microsoft Excel Hilfe	2	07.01.2009, 11:56
	Excel öffnet sehr langsam	falko	Microsoft Excel Hilfe	0	07.01.2009, 10:29

Gehe zu:

Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum posten
Du kannst Dateien in diesem Forum herunterladen

Powered by phpBB © 2001, 2002 phpBB Group :: FI Theme :: Alle Zeiten sind GMT + 1 Stunde
Deutsche Übersetzung von phpBB.de