Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
408to412
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
408to412
408to412
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Werte suchen / Code instabil

Werte suchen / Code instabil
10.04.2004 20:03:17
Erich M.
Hallo EXCEL-Freunde,
habe mit Hilfe des Forums - weiss leider nicht mehr von wem - einen Code
angepasst, der eigentlich funktioniert. Ich muss aus der Spalte xy (Tabelle2)
die Werte mit einer Spalte xy (Tabelle1) vergleichen und in die Tabelle "Gefunden"
kopieren.
Der Code bringt mich aber zur Verzweiflung wenn z.B. in Tabelle2 in der ersten
zeile ein Blank ist oder wenn er bei bestimmten Suchvorgängen Leerzellen
findet. Teilweise muss ich EXCEl "abstürzen lassen" - also den code nicht unbedingt
verwenden.
Aber vielleicht kann jemand ein Problem erkennen oder man kann mit "OnError" o.ä.
das Ganze verbessern.
Sub amehrfach()
Application.ScreenUpdating = False
mySpalte = "C" ' = in Tabelle1 aus der die Zeilen kopiert werden
mySpalte2 = "B" ' = in Tabelle2, aus der in dieser Spalte die Werte gesucht werden
Set wks1 = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
Set wksNeu = Sheets("Gefunden")
lng2 = IIf(IsEmpty(wks2.Cells(65536, mySpalte2)), wks2.Cells(65536, mySpalte2).End(xlUp).Row, 65536)
lngNeu = IIf(IsEmpty(wksNeu.Range("A65536")), wksNeu.Range("A65536").End(xlUp).Row + 1, 65536)
For lngRow = 1 To lng2
Set rng = wks1.Columns(mySpalte).Find(wks2.Cells(lngRow, mySpalte2), _
LookAt:=xlWhole, LookIn:=xlValues, after:=wks1.Cells(lngRow, mySpalte)) 'wks1.[A65536])
If Not rng Is Nothing Then
sFirst = rng.Address
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
Do
Set rng = wks1.Columns(mySpalte).FindNext(after:=rng)
If Not rng Is Nothing Then
If sFirst = rng.Address Then Exit Do
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
End If
Loop
End If
Next
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie
Besten Dank für eine Hilfe!
mfg
Erich

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Werte suchen / Code instabil
11.04.2004 08:31:30
Josef Ehrensberger
Hallo Erich!
Versuch's mal so!
'Option Explicit

Sub amehrfach()
Application.ScreenUpdating = False
mySpalte = "C" ' = in Tabelle1 aus der die Zeilen kopiert werden
mySpalte2 = "B" ' = in Tabelle2, aus der in dieser Spalte die Werte gesucht werden
Set wks1 = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
Set wksNeu = Sheets("Gefunden")
lng2 = IIf(IsEmpty(wks2.Cells(65536, mySpalte2)), wks2.Cells(65536, mySpalte2).End(xlUp).Row, 65536)
lngNeu = IIf(IsEmpty(wksNeu.Range("A65536")), wksNeu.Range("A65536").End(xlUp).Row + 1, 65536)
On Error Resume Next
For lngRow = 1 To lng2
Set rng = wks1.Columns(mySpalte).Find(wks2.Cells(lngRow, mySpalte2), _
LookAt:=xlWhole, LookIn:=xlValues, after:=wks1.Cells(lngRow, mySpalte)) 'wks1.[A65536])
If Not rng Is Nothing Then
sFirst = rng.Address
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
Do
Set rng = wks1.Columns(mySpalte).FindNext(after:=rng)
If Not rng Is Nothing Then
If sFirst = rng.Address Then Exit Do
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
End If
Loop
End If
Next
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß Sepp


Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.

(Sir Winston Churchill)


Anzeige
..schon ein Stück weiter... (nicht mehr instabil)
11.04.2004 10:17:02
Erich M.
Hallo Sepp,
zunächst besten Dank. Es reicht noch nicht ganz. Ich habe noch eine Abfrage eingebaut,
wenn die erste Zelle der Spalte B "" ist, dann Exit Sub. Das kann ich machen, weil dann
der User die erste Zeile einfach füllen kann.
Das geht allerdings nicht, wenn z.B. Zeile 3 und Zeile 5 belegt und die Zeile 4 = "".
Hier bräuchte ich noch eine Schleife o.ä., da derzeit der Code durchläuft bis 65536;
ich merke das, wenn ich über Debuggen abbreche, dann ist die Zeile
lngNeu = lngNeu + 1
gelb und es erscheint beim Zeiger dann eine Zeile 2367 oder 1859 - je nachdem wie weit
der Code ist.
Also, wenn in der Spalte B zwischen den zeilen eine Leerzeile ist, müsste das ignoriert
werden. Meine Versuche gehen aber ins Leere! Der Code sieht jetzt so aus; das eingefügte
habe ich gekennzeichnet:
Sub aamehrfach()
Application.ScreenUpdating = False
mySpalte = "C" ' = in Tabelle1 aus der die Zeilen kopiert werden
mySpalte2 = "B" ' = in Tabelle2, aus der in dieser Spalte die Werte gesucht werden
Set wks1 = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
Set wksNeu = Sheets("Gefunden")
' neu Beginn !!!!
If wks2.Cells(1, mySpalte2) = "" Then
MsgBox "leere Zelle"
Exit Sub
End If
' neu Ende !!!!
lng2 = IIf(IsEmpty(wks2.Cells(65536, mySpalte2)), wks2.Cells(65536, mySpalte2).End(xlUp).Row, 65536)
lngNeu = IIf(IsEmpty(wksNeu.Range("A65536")), wksNeu.Range("A65536").End(xlUp).Row + 1, 65536)
On Error Resume Next
For lngRow = 1 To lng2
Set rng = wks1.Columns(mySpalte).Find(wks2.Cells(lngRow, mySpalte2), _
LookAt:=xlWhole, LookIn:=xlValues, after:=wks1.Cells(lngRow, mySpalte)) 'wks1.[A65536])
If Not rng Is Nothing Then
sFirst = rng.Address
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
Do
Set rng = wks1.Columns(mySpalte).FindNext(after:=rng)
If Not rng Is Nothing Then
If sFirst = rng.Address Then Exit Do
On Error Resume Next
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
End If
Loop
End If
Next
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie
Besten Dank nochmals!
mfg
Erich
Anzeige
AW: ..schon ein Stück weiter... (nicht mehr instabil)
11.04.2004 10:23:53
Josef Ehrensberger
Hallo Erich!
Dann musst du halt abfragen, ob in der Zelle was steht!

Sub aamehrfach()
Application.ScreenUpdating = False
mySpalte = "C" ' = in Tabelle1 aus der die Zeilen kopiert werden
mySpalte2 = "B" ' = in Tabelle2, aus der in dieser Spalte die Werte gesucht werden
Set wks1 = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
Set wksNeu = Sheets("Gefunden")
' neu Beginn !!!!
If wks2.Cells(1, mySpalte2) = "" Then
MsgBox "leere Zelle"
Exit Sub
End If
' neu Ende !!!!
lng2 = IIf(IsEmpty(wks2.Cells(65536, mySpalte2)), wks2.Cells(65536, mySpalte2).End(xlUp).Row, 65536)
lngNeu = IIf(IsEmpty(wksNeu.Range("A65536")), wksNeu.Range("A65536").End(xlUp).Row + 1, 65536)
On Error Resume Next
For lngRow = 1 To lng2
If wks2.Cells(lngRow, mySpalte2) <> "" Then 'NEU
Set rng = wks1.Columns(mySpalte).Find(wks2.Cells(lngRow, mySpalte2), _
LookAt:=xlWhole, LookIn:=xlValues, after:=wks1.Cells(lngRow, mySpalte)) 'wks1.[A65536])
If Not rng Is Nothing Then
sFirst = rng.Address
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
Do
Set rng = wks1.Columns(mySpalte).FindNext(after:=rng)
If Not rng Is Nothing Then
If sFirst = rng.Address Then Exit Do
On Error Resume Next
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
End If
Loop
End If
End If 'NEU
Next
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß Sepp


Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.

(Sir Winston Churchill)


Anzeige
DANKE - Sepp! Super, das wars - o.T.!!
11.04.2004 10:32:46
Erich M.
.
Danke für die Rückmeldung! o.T.
11.04.2004 10:33:34
Josef Ehrensberger
Gruß Sepp

Ein kluger Mann macht nicht alle Fehler selbst.
Er lässt auch anderen eine Chance.

(Sir Winston Churchill)


Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige