Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1468to1472
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

Spaltenvergleich besser programmieren

Spaltenvergleich besser programmieren
19.01.2016 08:34:49
Willi
Hallo,
hier komme ich mal mit einem funktionierenden Modul. Da ich damit zwei Spalten zweier Tabellen gegeneinander vergleiche, dauert das bei ca. 36.000 Vergleichen eine gefühlte Ewigkeit.
Der Ablauf ist folgender:
1.) Jede Zelle aus Spalte M (CSV-Datei) wird mit allen Zellen in Spalte M (Alt-CSV)verglichen
2.) ist der Inhalt von CSV-Datei.M nicht in Alt-CSV.M dann wird die Zeile (nicht Zelle!) nach Tabelle Neu geschrieben

Sub Diff_Vergleich()
Dim i As Long, k As Long, lngZaehler As Long, z1 As Long
Dim wksU As Worksheet, wksV As Worksheet, wksH As Worksheet, wksM As Worksheet
Set wksU = Worksheets("Alt-CSV")
Set wksV = Worksheets("CSV-Datei")
Set wksH = Worksheets("NEU")
Set wksM = Worksheets("Alt")
x1 = Worksheets("CSV-Datei").UsedRange.SpecialCells(xlCellTypeLastCell).Row
y1 = Worksheets("Alt-CSV").UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To x1
For k = 2 To y1
If wksV.Cells(i, 13) = wksU.Cells(k, 13) Then
GoTo Weiter_i
Else
If wksU.Cells(k, 13) = "" Or i > y1 Then
wksV.Rows(i).Copy wksH.Rows(lngZaehler)
lngZaehler = lngZaehler + 1
d1 = d1 + 1
GoTo Weiter_i
End If
End If
If k = y1 And wksV.Cells(i, 13)  wksU.Cells(k, 13) Then
wksV.Rows(i).Copy wksH.Rows(lngZaehler)
lngZaehler = lngZaehler + 1
d1 = d1 + 1
GoTo Weiter_i
End If
If wksV.Cells(i, 13) = "" Then
GoTo Ende
End If
Next k
k = 2
Weiter_i:
Next i
Ende:
End Sub
Leider muß ich auch den Gegenvergleich anstellen, also:
1.) Jede Zelle aus Spalte M (Alt-CSV) wird mit allen Zellen in Spalte M (CSV-Datei)verglichen
2.) ist der Inhalt von Alt-CSV.M nicht in CSV-Datei.M dann wird die Zeile (nicht Zelle!) nach Tabelle Alt geschrieben.
Damit durchlaufe ich das Modul mit anderen Parametern zweimal :(
und das dauert.
Weiß jemand eine bessere vor allem aber schnellere Lösung?
Schon Vorab meinen herzlichen Dank.
Willi

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spaltenvergleich besser programmieren
19.01.2016 08:53:42
Daniel
Hi
1. Sortiere CSV-alt und CSV-neu nach Spalte M aufsteigend
2. Mache den Vergleich mit Hilfe des SVerweises mit 4. Parameter = Wahr.
Dieser ist aufgrund der Sortierung sehr schnell.
Die Formel sieht etwa so aus und kommt in eine Hilsspalte am Tabellenende von Csv-Datei ab Zeile 2:
=Wenn(SVerweis(m2;alt-csv!m:m;1;wahr)=m2;"";"x")
3. Kopieren jetzt alle Zeilen die ein X inder Hilfsspalte haben nach neu (z.b. Autofilter)
Wenn du vorher nochmal nach der Hilfsspalte sortierst stehen alle zu kopierenden Zeilen direkt untereinander und auch das kopieren geht noch schneller.
Für die Befüllung von Tabelle alt dann analog
Gruß Daniel

Anzeige
AW: Spaltenvergleich besser programmieren
19.01.2016 09:06:41
UweD
Hallo
So? benutzt die Zählenwennfunktion

Sub Diff_Vergleich()
Dim i As Long, x1 As Long, y1 As Long, k1 As Long
Dim wksU As Worksheet, wksV As Worksheet, wksH As Worksheet, wksM As Worksheet
Set wksU = Worksheets("Alt-CSV")
Set wksV = Worksheets("CSV-Datei")
Set wksH = Worksheets("NEU")
Set wksM = Worksheets("Alt")
x1 = wksV.UsedRange.SpecialCells(xlCellTypeLastCell).Row
y1 = wksV.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To x1
If WorksheetFunction.CountIf(wksU.Columns(13), wksV.Cells(i, 13)) = 0 Then
k1 = wksH.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
wksV.Rows(i).Copy wksH.Rows(k1)
End If
Next
For i = 2 To y1
If WorksheetFunction.CountIf(wksV.Columns(13), wksU.Cells(i, 13)) = 0 Then
k1 = wksM.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
wksU.Rows(i).Copy wksM.Rows(k1)
End If
Next
End Sub
Gruß UweD

Anzeige
AW: Spaltenvergleich besser programmieren
19.01.2016 10:47:48
Willi
UweD,
D A N K E ! ! ! ! !
Ich knie nieder! Das ist ja super.
Jetzt bleibt mir nur eine Frage:
wie komme ich an das Wissen um solche Programmierung

If WorksheetFunction.CountIf(wksU.Columns(13), wksV.Cells(i, 13)) = 0 Then
k1 = wksH.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
zu erstellen?
Obwohl ich mir zu VBA Bücher beschafft habe, finde ich darin nichts zu
CountIf
SpecialCells
xlCellTypeLastCell.
Denn eines ist klar, kennt man die möglichen Befehle nicht, landet man im Nirvana. Hast Du da einen Tip für mich? (Buch / Internetseite zum Nachschlagen o.ä.) Ich will ja nicht immer nur dämliche Fragen stellen ;-))
Nochmals Danke!
Willi

Anzeige
AW: noch ein Fehler
19.01.2016 11:04:05
UweD
Hallo
ist enthalten. V durch U ersetzen
y1 = wksU.UsedRange.SpecialCells(xlCellTypeLastCell).Row
LG UweD
P.S.
Ich habe Vieles durch hier mitlesen gelernt...

AW: Spaltenvergleich besser programmieren
19.01.2016 11:13:09
EtoPHG
Hallo Willi,
Dazu brauchst du erstmal keine Bücher. Die interne Excel-Hilfe gibt schon ziemlich umfassend Auskunft:
Cursor im VBE-Editor ein Wort, wie CountIf oder Specialcells markieren und F1 drücken.
Von der internen Hilfe kommst du auf Objektbeschreibung, Elemente (Methoden und Eigenschaften) und oft auch auf kleine Programmierbeispiele.
Ausführlichere Informationen sind dann z.B. bei MS in MSDN zu finden.
Gruess Hansueli

Anzeige
AW: Spaltenvergleich besser programmieren
19.01.2016 11:25:53
Daniel
Auch sollte man sich, bevor man anfängt für Excel VBA-Makros zu programmieren, mit den Excelmenüfunktionen beschäftigten.
Diese Excelmenüfunktionen kann man auch in der VBA-Programmierung nutzen.
"SpecialCells" und "xlCelltypeLasCell" kommen aus der Menüfunktion START - BEARBEITEN - SUCHEN UND AUSWÄHLEN - INHALTE
Um dann herauszufinden, wie man diese Menüfunktionen in VBA programmiert, kann man den Makrorecorder verwenden.
Gruß Daniel

AW: Spaltenvergleich besser programmieren
19.01.2016 11:39:12
Willi
Hallo,
Sorry, aber jetzt muß ich meine Frage doch noch erweitern, Ich hatte mir das so einfach vorgestellt, und dachte den Rest könnte ich selber, aber weit gefehlt. Ich habe nämlich noch eine dritte Abfrage, und nachdem mir eine For Schleife "weggebrochen" ist, weiß ich nicht weiter:
1.) hier wird nun die CSV-Datei.M mit Alt-CSV.M verglichen (haben wir ja schon).
2.) wenn die Werte in beiden Tabellen - Spalten enthalten sind sollen in der jeweiligen Zeile in der Spalte G die Werte verglichen werden.
3.)wenn die G's gleich sind weiter, ansonsten soll - wie gehabt - von CSV-Datei nach Worksheets("NEU")
kopiert werden.

lngZaehler = 2
d3 = 0
For i = 2 To x1
For k = 2 To y1
If wksV.Cells(i, 13) = wksU.Cells(k, 13) Then
If wksV.Cells(i, 7) = wksU.Cells(k, 7) Then
GoTo Weiter_i2
Else
wksV.Rows(i).Copy wksM.Rows(lngZaehler)
lngZaehler = lngZaehler + 1
d3 = d3 + 1
GoTo Weiter_i2
End If
End If
Next k
k = 2
Weiter_i2:
Next i
Ich denke, daß es ja keinen Sinn macht auch die Spalte G wie den Abgleich vorher zu behandeln. Aber wie dann, denn die Geschwindigkeit mit der das jetzt läuft, vergleicht und schreibt möchte ich natürlich gerne beibehalten.
Ich sage schon mal im Voraus Danke.
Willi

Anzeige
AW: Spaltenvergleich besser programmieren
19.01.2016 11:54:36
UweD
so?

Sub Diff_Vergleich()
Dim i As Long, x1 As Long, y1 As Long, k1 As Long, l1 As Long
Dim wksU As Worksheet, wksV As Worksheet, wksH As Worksheet, wksM As Worksheet
Set wksU = Worksheets("Alt-CSV")
Set wksV = Worksheets("CSV-Datei")
Set wksH = Worksheets("NEU")
Set wksM = Worksheets("Alt")
x1 = wksV.UsedRange.SpecialCells(xlCellTypeLastCell).Row
y1 = wksU.UsedRange.SpecialCells(xlCellTypeLastCell).Row
k1 = wksH.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
l1 = wksM.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
For i = 2 To x1
If WorksheetFunction.CountIf(wksU.Columns(13), wksV.Cells(i, 13)) = 0 Then
wksV.Rows(i).Copy wksH.Rows(k1)
k1 = k1 + 1
ElseIf wksU.Cells(i, 7)  wksV.Cells(i, 7) Then
wksV.Rows(i).Copy wksH.Rows(k1)
k1 = k1 + 1
End If
Next
For i = 2 To y1
If WorksheetFunction.CountIf(wksV.Columns(13), wksU.Cells(i, 13)) = 0 Then
wksU.Rows(i).Copy wksM.Rows(l1)
l1 = l1 + 1
ElseIf wksU.Cells(i, 7)  wksV.Cells(i, 7) Then
wksU.Rows(i).Copy wksM.Rows(l1)
l1 = l1 + 1
End If
Next
End Sub
Gruß UweD

Anzeige
AW: Spaltenvergleich besser programmieren
19.01.2016 14:36:03
Willi
Hallo,
soviel Hilfe hatte ich wirklich nicht erwartet. Erstmal ganz herzlichen Dank dafür.
Aber jetzt:
Daniel - Deine Programmierung ist - für mich! - so kryptisch, daß ich vollkommen überfordert bin und ich habe immer noch den Anspruch wenigstens zu verstehen - wenn ich es schon nicht selber kann - die eingesetzte Programmierung zu verstehen. Nichts desto trotz ist das natürlich etwas, womit ich mich auseinandersetzte, denn mehr Wissen schadet bekanntlich auch nicht. Außerdem - laß mir doch wenigstens die Zeit um einen Kaffee holen zu können ;-).
Bleibt jetzt die Hilfe von UweD. Das Folgende betrifft jetzt

For i = 2 To y1
If WorksheetFunction.CountIf(wksV.Columns(13), wksU.Cells(i, 13)) = 0 Then
wksU.Rows(i).Copy wksM.Rows(l1)
l1 = l1 + 1
ElseIf wksU.Cells(i, 7)  wksV.Cells(i, 7) Then
wksU.Rows(i).Copy wksM.Rows(l1)
l1 = l1 + 1
End If
Next
Entweder verstehe ich es nicht, oder es kommt tatsächlich nicht das heraus, was zu erwarten ist. Grund:
im ElseIf arbeitest Du bei beiden Tabellen mit (i,7). Da ja aber durchaus - s. a. Deine Programmierung:

For i = 2 To x1
If WorksheetFunction.CountIf(wksU.Columns(13), wksV.Cells(i, 13)) = 0 Then
k1 = wksH.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
wksV.Rows(i).Copy wksH.Rows(k1)
End If
Next
For i = 2 To y1
If WorksheetFunction.CountIf(wksV.Columns(13), wksU.Cells(i, 13)) = 0 Then
k1 = wksM.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
wksU.Rows(i).Copy wksM.Rows(k1)
End If
Next
die Zeilen, die in der einen Tabelle, bzw. in der anderen Tabelle nicht vorhanden sind, nicht gelöscht werden (und auch nicht dürfen), steht m.E. irgendwann in CSV-Datei.M Zeile 4090 nicht mehr dasselbe wie in Alt-CSV.M. Damit muß doch dann aber auch die Abfrage auf Spalte 7 ein Ergebnis liefern, daß falsch ist, da sich die Zeilen verschoben haben.
Soll heißen: z.B. Spalte 7 von CSV-Datei.M Zeile 4090 wäre dann mit Spalte 7 Alt-CSV.M Zeile 4091 (oder 4089 o.ä) zu vergleichen?!
Liege ich da richtig, oder mache ich einen Gedankenfehler?
Grüße
Willi

Anzeige
AW: Spaltenvergleich besser programmieren
19.01.2016 15:10:09
Daniel
Hi
auch wenn der Code vielleicht kryptisch aussieht, der Ablauf ist eigentlich ganz einfach:
1. ich schreibe in die erste freie Spalte am Tabellenende eine Formel, die alle Zeilen welche kopiert werden müssen mit 1 kennzeichnet und die die nicht kopiert werden müssen mit dem Leerstring.
um festzustellen, ob ein Wert aus der einen Tabelle in der anderen Tabelle vorhanden ist, verwende ich den SVerweis, weil dieser in sortierten Daten hierfür wesentlich schneller arbeitet als ein ZählenWenn.
2. über die Excelfunktion START - BEARBEITEN - SUCHEN UND AUSWERTEN - INHALTE - KONSTANTEN ZAHLEN selektiere ich dann in der Hilfsspalte die Werte mit der 1 um sie dann in die andere Tabelle zu kopieren.
auch hier sortiere ich, um den Ablauf zu beschleunigen.
mehr ist es nicht:
- Vergleichstabelle sortieren
- Formel einfügen
- Formel durch Wert ersetzen
- sortieren
- alle zellen mit Zahl selektieren und kopieren
- Hilfsspalte löschen
im Prinzip kannst du diese Schritte auch von Hand ausführen ohne ein Makro dafür zu benutzen.
das Makro bildet dann nur noch diese einfachen Schritte nach.
Gruß Daniel

Anzeige
AW: Spaltenvergleich besser programmieren
20.01.2016 08:25:02
Willi
Hallo,
jetzt habe ich Daniels Code mal ausprobiert und habe ein absolut kurioses Ergebnis:
während der Vergleich CSV-Datei (A) mit Alt-CSV (B) 3154 neue Zeilen ergibt (stimmt definitiv nicht - ich habe die ausgeworfenen Nummern nochmal in den Tabellen A & B überprüft, sind in beiden Tabellen enthalten) ergibt sich bei der entgegengesetzten Suche nur zwei Unterschiede, die auch korrekt sind (nicht wissend, ob da ggf. jetzt einige fehlen?)
Zwar warst Du so nett mir den Ablauf zu beschreiben, aber trotz intensiven anstarrens des Codes hat er sich mir nicht offenbart, soll heißen, ich weiß nicht, wo ich eingreifen soll/kann//muß (zur Info: die Tabellen haben um die 6000 Zeilen und (bereits jetzt) 60 Spalten(ich befürchte, daß das noch mehr wird)), um eine Änderung des Ergebnisses zu erzielen.
Grüße
Willi
PS: Aber eins muß ich zugegen: das ist wirklich sauschnell!! Und mein Kaffee? ;)

Anzeige
AW: Spaltenvergleich besser programmieren
20.01.2016 09:48:41
Daniel
Hi
Ohne deinen Code und deine Datei zu kennen kann man da schwer was zu sagen.
Setze mal nach dem einfügen der Formel einen Haltepunkt.
Schaue dir dann wenn der Code stoppt die eingefügte Formel in der Tabelle an und prüfe, ob sie auf die richtigen Zellen referenziert.
Gruß Daniel
PS das mit dem Kaffee trinken während der Rechner arbeitet ist jetzt vorbei.

AW: Spaltenvergleich besser programmieren
19.01.2016 15:42:53
UweD
Hi
nein, der Gedankenfehler liegt bei mir.
Du hast Recht, die Werte stehen seltenst in der gleichen Zeile der beiden Tabellen
(ausser in meiner 5 Zeilen langen Musterdatei)
Da muss ich wohl nochmal ran. Aber das wird heute nichts mehr.
LG UweD
- - -
Daniels Lösung habe ich noch nicht ausprobiert. Hört sich aber super an.
Liefert die denn das richtige ergebnis

AW: Spaltenvergleich besser programmieren
25.01.2016 12:54:41
Willi
Hallo,
nachdem ich jetzt fast das gesamte Wochenende mit dem Versuch zugebracht habe die Doppelschleife sinnvoll und vor allem schnell anders zu programmieren (aus dem bereits von Euch vorgegebenen), gebe ich auf und bitte Euch doch nochmal tätig zu werden. Ich komme von :

Sub Diff_Vergleich()
Dim i As Long, k As Long, lngZaehler As Long, z1 As Long
Dim wksU As Worksheet, wksV As Worksheet, wksH As Worksheet, wksM As Worksheet, wksJ As  _
Worksheet
Dim Kat As String, Kategorie As String
Set wksU = Worksheets("Alt-CSV")
Set wksV = Worksheets("CSV-Datei")
Set wksH = Worksheets("NEU")
Set wksM = Worksheets("Alt")
Set wksJ = Worksheets("Preis-Differenz")
x1 = Worksheets("CSV-Datei").UsedRange.SpecialCells(xlCellTypeLastCell).Rowfest
y1 = Worksheets("Alt-CSV").UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 2 To x1
For k = 2 To y1
If wksV.Cells(i, 13) = wksU.Cells(k, 13) Then
If wksV.Cells(i, 7) = wksU.Cells(k, 7) Then
GoTo Weiter_i2
Else
wksV.Rows(i).Copy wksJ.Rows(lngZaehler)
lngZaehler = lngZaehler + 1
GoTo Weiter_i2
End If
End If
Next k
k = 2
Weiter_i2:
Next i
einfach nicht weg, da alle meine anderen Versuche gar nicht funktionieren, oder unsinnige Ergebnisse auswerfen.
Hat noch jemand eine Idee, wie man die Laufzeit von derzeit 25 Minuten reduzieren kann?
Danke schon mal
Willi

AW: Spaltenvergleich besser programmieren
19.01.2016 12:40:29
Daniel
HI
probier mal das, sollte noch etwas schneller sein (allerdings werden die Daten neu sortiert)
die Zeilenumbrüche im Code welche vom VBA-Editor hier eingefügt werden, musst du entfernen:

Sub test()
Dim wksU As Worksheet, wksV As Worksheet, wksH As Worksheet, wksM As Worksheet
Dim FO As String
Set wksU = Worksheets("Alt-CSV")
Set wksV = Worksheets("CSV-Datei")
Set wksH = Worksheets("NEU")
Set wksM = Worksheets("Alt")
'--- Einträge von CSV-Datei nach NEU, wenn nicht in Alt-CSV vorhanden oder Wert in Spalte G  _
abweichend
wksU.UsedRange.Sort key1:=wksU.Cells(1, 13).Value, order1:=xlAscending, Header:=xlYes
FO = "=IFERROR(IF(VLookUp(RC13,'xxx'!C13,1,1)RC13,1,IF(RC7Index('xxx'!C7,Match(RC13,'xxx'! _
C13,1)),1,"""")),1)"
FO = Replace(FO, "xxx", wksU.Name)
With wksV.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = FO
.Formula = .Value
If WorksheetFunction.Sum(.Cells) > 0 Then
.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes 'sortieren  _
beschleunigt kopieren
.SpecialCells(xlCellTypeConstants, 1).EntireRow.Resize(, .Column - 1).Copy wksH. _
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
.ClearContents
End With
End With
'--- Einträge von CSV-alt nach ALT, wenn nicht in CSV-Datei vorhanden
wksV.UsedRange.Sort key1:=wksV.Cells(1, 13).Value, order1:=xlAscending, Header:=xlYes
FO = "=IFERROR(IF(VLookUp(RC13,'xxx'!C13,1,1)RC13,1,""""),1)"
FO = Replace(FO, "xxx", wksV.Name)
With wksU.UsedRange
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = FO
.Formula = .Value
If WorksheetFunction.Sum(.Cells) > 0 Then
.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes 'sortieren  _
beschleunigt kopieren
.SpecialCells(xlCellTypeConstants, 1).EntireRow.Resize(, .Column - 1).Copy wksM. _
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
.ClearContents
End With
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige