VBA: Werte vergleichen, Zellen kopieren
Dominik Henne
ich habe gesehen, dass es schon einige Threads zum Thema "Tabellen
vergleichen" gibt, jedoch ist nicht das Richtige für mich dabei.
Ich habe ein Tabellenblatt ("Tabelle1") mit Werten, wobei der Wert in
Spalte "B" auch irgendwo in Spalte "B" des Blatts "Testdaten1"
vorkommt. Mein Ziel ist es den zugehörigen Wert im Sheet "Testdaten1"
zu finden und die Zellen A:G in "Tabelle1" I:O einzutragen.
Bei meinem Code tritt immer der Fehler 1004 ("Anwendungs- oder
objektdefinierter Fehler") auf:
'*******************************************
Dim Search As String, rng As Range
Dim Sp As String, FirstAddress As String
Dim c As Integer
Sp = "B"
c = 1
Do Until c = Worksheets("Tabelle1").UsedRange.Rows.Count
c = c + 1
Search = Worksheets("Tabelle1").Range("B" & c).Value
Set rng = Worksheets("Testdaten1").Range("B:B").Find _
(What:=Search, LookAt:=xlPart, LookIn:=xlValues)
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
With Worksheets("Tabelle1")
Worksheets("Testdaten1").Range("A" & rng & ":G" & rng).Copy _ 'hier
kommt die
Destination:=Worksheets("Tabelle1").Range("I" & c)
'Fehlermeldung
End With
Set rng = Worksheets("Testdaten1").Range("B:B").FindNext(after:=rng)
If rng.Address = FirstAddress Then Exit Do
Loop
End If
Loop
'*******************************************
Ich hoffe, dass mir jemand helfen kann.
Danke im Voraus.
Gruß,
Dominik
-
Win XP Pro, Excel 2003
Kai Ottenbacher
ungetestet:
Ändere mal die Zeile
Worksheets("Testdaten1").Range("A" & rng & ":G" & rng).Copy
zu
Worksheets("Testdaten1").Range("A" & rng.Row & ":G" & rng.Column).Copy
damit VBA auch weiß, welche Zeile und Spalte kopiert werden soll...
Gruss, Kai
Dominik Henne
kleiner Fehler, große Wirkung. Danke für deine Hilfe.
Prinzipiell läuft das Programm jetzt. Da ich aber ca. 30.000 Zeilen in
jedem Arbeitsblatt habe, dauert ein Durchlauf extrem lange. Wie lange
kann ich nicht sagen, da ich nach einer Stunde (CPU-Auslastung 100%)
Excel beendet habe.
Gibt es noch irgendeine Möglichkeit den Vorgang zu beschleunigen?
Danke für Eure Hilfe.
Gruß,
Dominik
Kai Ottenbacher
wäre es evtl. eine Idee, die zu Kopierenden Zeilen in "Testdaten1" per
Filter zu ermitteln um dann die sichtbaren Zeilen nach "Tabelle1" zu
kopieren? Damit sollte der Vorgang wesentlich schneller ablaufen als
jedes Mal 30000 Zellen zu durchsuchen.
Gruss, Kai
Dominik Henne
eigentlich eine gute Idee, geht aber nicht, weil nicht alle Werte in
beiden Tabellen vorhanden sind.
Ich lasse es heute mal über Nacht laufen, und gucke was raus kommt.
Ich melde mich dann morgen wieder.
Danke für deine Hilfe.
Gruß,
Dominik
Dominik Henne
nach 2 Stunden war das Programm durchgelaufen.
Eigentlich sollten ja bei identischen Werten in Spalte "B" die Zellen A
bis G aus Testdaten1 in Tabelle1 kopiert werden. Leider hat die
Zuordnung überhaupt nicht funktioniert. Es wurden zwar alle Werte aus
Testdaten1 in Tabelle1 kopiert, aber leider passen die Werte nicht
zusammen.
Das Problem muss also am Anfang des Codes sein. Ich denke mal, dass
"Search = Worksheets("Tabelle1").Range("B" & c).Value " nicht den Wert
ausgibt der in der Zelle steht. Ich weiß aber auch nicht wie ich die
Werte sonst vergleichen und suchen soll.
Ich hoffe jemand kann mir eine Hilfestellung geben.
Schon mal Danke im Voraus.
Gruß,
Dominik
Kai Ottenbacher
2 Fragen:
- können in deinen Quelldaten (Testdaten1) in den durchsuchten Werten
Duplikate vorkommen? wenn ja, wie soll mit diesen verfahren werden?
- können in deiner Zieltabelle (Tabelle1) in den Suchkriterien
Duplikate vorkommen? wenn ja, wie soll mit diesen verfahren werden?
Gruss, kai
Dominik Henne
in beiden Tabellen kommen alle Werte in Spalte B nur jeweils ein Mal
vor.
Ich versuche das Ganze jetzt mal mit einer For...Each Schleife.
Gruß,
Dominik
Kai Ottenbacher
ich habe mal versucht, dein Problem nachzustellen unter folg.
Prämissen, die du evtl. noch im Code abändern musst:
Quelldaten: Sheets("Quelle")
Zieldaten: Sheets("Ziel")
Die zu vergleichenden Werte stehen jeweils in Spalte "A"
Bei Übereinstimmung werden die Spalten "A" und "B" aus dem Blatt
"Quelle" in Spalte "B" und "C" um Blatt "Ziel" kopiert.
Funktioniert soweit die Werte jeweils nur 1x vorkommen und geht mE.
recht schnell.
Das 'Sheet("Quelle").Activate' ist zwar hässlich, aber ohne gibt's
eine Fehlermeldung, die ich anders nicht in den Griff bekomme.
Sub Kopieren()
Dim rngZiel As Range, rngQuelle As Range
For Each rngZiel In Sheets("Ziel").Range("A1:A" &
(Sheets("Ziel").Cells(Rows.Count, 1).End(xlUp).Row))
With Sheets("Quelle").Range("A1:A" &
(Sheets("Quelle").Cells(Rows.Count, 1).End(xlUp).Row))
Set rngQuelle = .Find(rngZiel.Value, LookIn:=xlValues,
LookAt:=xlWhole)
If Not rngQuelle Is Nothing Then
With Sheets("Quelle")
.Activate
.Range(Cells(rngQuelle.Row, rngQuelle.Column),
Cells(rngQuelle.Row, rngQuelle.Column + 1)).Copy _
Destination:=Sheets("Ziel").Cells(rngZiel.Row,
rngZiel.Column + 1)
End With
End If
End With
Next rngZiel
End Sub
Gruss, kai
Michael Schwimmer
"Dominik Henne" schrieb:
> Prinzipiell läuft das Programm jetzt. Da ich aber ca. 30.000 Zeilen
> in jedem Arbeitsblatt habe, dauert ein Durchlauf extrem lange. Wie
> lange kann ich nicht sagen, da ich nach einer Stunde (CPU-Auslastung
> 100%) Excel beendet habe.
unakzeptabel!
> Gibt es noch irgendeine Möglichkeit den Vorgang zu beschleunigen?
Probiere mal folgenden Code. Bei 65536 gefüllten Zeilen (umgekehrte
Sortierung) hat der Vorgang bei mir auf dem Laptop Athlon 4 1200 MHz
ca. 20 Sekunden gedauert.
Sub Übertragen()
Dim colDummy As Collection
Dim colZeilen As New Collection
Dim i As Long
Dim k As Long
Dim strSearch As String
Dim varDummy As Variant
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim dtmBeginn As Date
On Error Resume Next
dtmBeginn = Now
Set wsZiel = Worksheets("Tabelle1")
Set wsQuelle = Worksheets("Tabelle2")
With wsZiel 'Zieldatenblatt
For i = 1 To 65536
strSearch = CStr(.Cells(i, 2))
If strSearch <> "" Then
Set colDummy = New Collection
colZeilen.Add colDummy, "X-" & strSearch
colZeilen("X-" & strSearch).Add i, "Zielzeile"
End If
Next
End With
With wsQuelle 'Tabelle mit allen Daten
For i = 1 To 65536
strSearch = CStr(.Cells(i, 2))
If strSearch <> "" Then
colZeilen("X-" & strSearch).Add i, "Quellzeile"
End If
Next
End With
With wsZiel 'Zieldatenblatt
Application.ScreenUpdating = False
For Each varDummy In colZeilen
i = varDummy("Zielzeile")
k = varDummy("Quellzeile")
.Range(.Cells(i, 1), .Cells(i, 7)).Value = _
wsQuelle.Range( _
wsQuelle.Cells(k, 1), wsQuelle.Cells(k, 7) _
).Value
Next
Application.ScreenUpdating = True
End With
MsgBox "Dauer : " & Format(Now - dtmBeginn, "nn:ss")
End Sub
MfG
Michael
--
Michael Schwimmer
Home : http://michael-schwimmer.de
Excel VBA ISBN 3-8273-2183-2
Dominik Henne
ich habe es mittlerweile auch mit der For...Each Schleife probiert.
Dauert mir aber immer noch zu lange.
Vielen Dank für deine Unterstützung.
Gruß,
Dominik
Dominik Henne
ich kann nur sagen "Wow". Bei meinen Testdaten hat der Durchlauf 9
Sekunden gedauert.
Ich habe nur noch die Zielzellen für die kopierten Daten in "
.Range(.Cells(i, 9), .Cells(i, 15)).Value = wsQuelle.Range( ...."
geändert damit die Daten nebeneinander stehen und nicht überschrieben
werden.
Eine super Lösung. 1000 Dank an dich Michael.
Gruß,
Dominik
Lars P. Wolschner
> Hallo Domik,
>
> ich habe mal versucht, dein Problem nachzustellen unter folg.
> Prämissen, die du evtl. noch im Code abändern musst:
> Quelldaten: Sheets("Quelle")
> Zieldaten: Sheets("Ziel")
Da würde ich die Namen der Tabellenblätter als Parameter nehmen und
in der Sub erstmal Worksheet-Objekte dazu anlegen:
Public Sub Copy( _
ByVal xls As Excel.Workbook, _
ByRef strWorksheetFrom As String, _
ByRef strWorksheetTo As String)
On Error Resume Next
Dim shtFrom As Excel.Worksheet, shtTo As Excel.Worksheet
Set shtFrom = xls.Worksheets(strWorksheetFrom)
Set shtTo = xls.Worksheets(strWorksheetTo)
If (shtFrom Is Nothing) Or (shtTo Is Nothing) Then Exit Sub
'...
End Sub
CU
--
Lars P. Wolschner lars.wo...@nexgo.de
Bernardstraße 11b lars.wo...@gmx.de
D-63067 Offenbach am Main
Fon & Fax: +49 69 80068670 Mobil: +49 163 8122462 (eplus)
Michael Schwimmer
"Dominik Henne" schrieb:
freut mich, wenn's dir weiterhilft.
Und Danke für die Rückmeldung!
Matthias Belleflamme
habe heute erst den Thread entdeckt, weil ich ein ähnliches Problem wie
Dominik Henne habe.
Nur kopiert er bei dem von Euch entwickelten Code nicht alle Daten von der
Master- in die zu vergleichende Tabelle, obwohl diese dort auch vorhanden
und identisch sind.
Es handelt sich um Fahrtenlisten mit schwankend 2.500 bis 15.000 Zeilen.
Fahrtart lfd.Nummer Fahrt AB Fahrt AN Dauer d. Fahrt Ort AB
Ort AN FahrtOrg
Linienf 1 03:00 04:00 1:00
MUC CGN N
Linienf 2 03:04 03:46 0:42
ARG HGZ N
usw.
Habt Ihr noch eine Hilfestellung für mich