Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
396to400
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
396to400
396to400
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Teil 1 gelöst

Daten vergleichen / Fortsetzung 2
15.03.2004 07:10:01
Erich M.
Hallo EXCEL-Freunde,
mit folgendem Thread hatte ich gedacht ich hätte die Lösung:
https://www.herber.de/forum/archiv/396to400/t397380.htm
Lösungsvorschlag:

Sub Daten_vergleichen_und_ergänzen()
Sheets(2).Activate
r = Cells(65536, 1).End(xlUp).Row
For i = 1 To r
Wert = Cells(i, 1)
With Sheets(1).Columns(1)
Set c = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
For j = 2 To 20
If j <> 11 And j <> 13 And j <> 14 And j <> 16 And j <> 17 Then
Cells(i, j) = c(1, j)
End If
Next j
End With
Next i
End Sub

Nun gibt es aber doch zwei Probleme:
1. Es erfolgt die Fehlermeldung "End With ohne With" (makriert wird End With)??
2. Wenn beim abgleichen der gesuchte Wert in Sheets(1) zweimal vorkommt,
dann werden "logischerweise" in Sheet(2) nur einmal die gesuchten Spalten
aus einer Zeile von Sheet(1) übertragen:
Deshalb folgende Frage:
Kann man den code so ergänzen, dass
a) die Werte aus Spalte 1, Sheet(2)
b) in sheet(1), Spalte 1 gesucht werden und
c) dann in einem Sheet(3) so eingetragen werden, dass die jeweils komplette
Zeile des sheets(1) übertragen wird (auf eine Reduzierung auf ausgewählte
Spalten würde ich verzichten, da dies vielleicht dann zu kompliziert wird).
Das heisst, es werden auch alle Zeilen übertragen, wenn der Wert in Sheet(1),
Spalte 1, mehrmals vorkommt.
Zunächst wäre mir natürlich auch bei der Lösung zu 1 geholfen.
Besten Dank für eine Hilfe!
mfg
Erich

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten vergleichen / Fortsetzung 2
15.03.2004 07:17:28
Hajo_Zi
Hallo Erich
zu1
es fehlt ein End If

Sub Daten_vergleichen_und_ergänzen()
Sheets(2).Activate
r = Cells(65536, 1).End(xlUp).Row
For i = 1 To r
Wert = Cells(i, 1)
With Sheets(1).Columns(1)
Set c = .Find(Wert, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
For j = 2 To 20
If j <> 11 And j <> 13 And j <> 14 And j <> 16 And j <> 17 Then
Cells(i, j) = c(1, j)
End If
Next j
            End If
End With
Next i
End Sub


Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Pro und Excel Version XP Pro


Anzeige
Teil 1 gelöst
15.03.2004 09:04:21
Erich M.
Hallo Hajo,
besten Dank!!
(hab mal wieder zu kompliziert gedacht!)
mfg
Erich

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige