PDA

Vollständige Version anzeigen : Wert in Zelle in mehreren Spalten suchen


ZiMi SiMi
02.08.2012, 13:53
Hall zusammen

Dürfte ich um eure Hilfe bitten.

Folgender Code bewirkt, dass der Wert der in der Zelle i7 steht in einer anderen Datei quelle.xlsx gesucht wird. Jedoch wird dafür nur in der 2 Spalte gesucht.

Gibt es eine Möglichkeit, dass in mehreren Zellen gesucht wird? wenn ja was müsste ich ändern? resp. wie erweitern?

hier der dafür zuständige teil: If db.Cells(y, 2).Value = Worksheets("Eingabemaske").Range("i7").

Und dier der ganze Code:

Sub daten()
Dim wb As Workbook
Dim db As Worksheet
Dim dbziel As Worksheet
Dim x As Long, y As Long, lngzeilen As Long
Application.ScreenUpdating = False
Set wb = GetObject("M:\10\quelle.xlsx")
Set db = Workbooks("quelle.xlsx").Worksheets("quelle")
Set dbziel = Worksheets("Finder")
Worksheets("finder").Cells.Value = ""
lngzeilen = db.Cells(db.Rows.Count, 1).End(xlUp).Row
x = 7
For y = 1 To lngzeilen
If db.Cells(y, 2).Value = Worksheets("Eingabe").Range("i7").Value Then
db.Rows(y).Copy dbziel.Rows(x)
x = x + 1
End If
Next y
Workbooks("quelle.xlsx").Close
End Sub

Vielen Dank für Eure Hilfe.

gruss

hoerzt
02.08.2012, 15:29
Hallo,

mal als Anstoss:

setze eine weitere Schleife um die bereits vorhandene Schleife mit dem Laufindex y.

Dabei kannst du dann z.B. den Laufindex z von 2 bis 5 (für Spalte 2 bis 5) laufen lassen, wenn du den festen Wert 2 eben durch z ersetzt.

LG hoerzt

jeder mann
02.08.2012, 15:38
Hallo, ZiMi SiMi,

die Find-Funktion einsetzen und den Suchbereich auf den Bereich einschränken, der durchsucht werden soll. Die VBA-Hilfe bietet ein Beispiel, hier im Forum sollten auch Beispiele für fortlaufende Suche ohne Laufzeitfehler zu finden sein.

ZiMi SiMi
06.08.2012, 16:23
Vielen Dank Euch beiden für Eure Info.

Ich habe versucht, das ganze mit der Find-Funktion umzusetzten. Irgendwie bringe ich das nicht hin.

Ich muss aber auch gestehen, dass ich ganz am Anfang von VBA stehe und das hier ein gebastel aus mehreren Codes war ;)

Könnte mir da jemand weiterhelfen?

Vielen Dank

ZiMi SiMi
10.08.2012, 12:23
Hallo zusammen

Falls jemand auch danach sucht, hier noch der neue Code.

Eventuell hat ja jemand eine noch schnellere Variante ;)
Er funktioniert zwar gut, braucht aber seine Zeit

Sub daten()
Dim wb As Workbook
Dim db As Worksheet
Dim dbziel As Worksheet
Dim x As Long, y As Long, lngzeilen As Long, s As Long
Application.ScreenUpdating = False
Set wb = GetObject("M:\L10\DB.xlsx")
Set db = Workbooks("DB.xlsx").Worksheets("quelle")
Set dbziel = Worksheets("Finder")
Worksheets("finder").Cells.Value = ""
lngzeilen = db.Cells(db.Rows.Count, 1).End(xlUp).Row
x = 7


For s = 1 To 3 ' durchläuft die ersten 3spalten

For y = 1 To lngzeilen
If db.Cells(y, s).Value = Worksheets("Auswertung").Range("G14").Value Then
db.Rows(y).Copy dbziel.Rows(x)
x = x + 1
End If
Next y


Next s

Workbooks("DB.xlsx").Close


End Sub


beste grüsse

jeder mann
12.08.2012, 07:29
Hallo, ZiMi SiMi,

Du setzt im Code zwar dbziel, verwendest aber danach nicht diese Variable zur Ansprache, sondern den Namen der Tabelle. Und die gängige Bezeichnung, die für ein Worksheet in VBA verwendet wird, ist meines Wissens wks oder ws, nicht db (das steht für mich für eine Datenbanktabelle).

Je mehr ich mir Deinen Code ansehe, desto deutlicher wird für mich, dass Du mit der Verwendung des Spezialfilters, dessen Kriterienbereich auf der Tabelle Finder steht ebenso wie der Ausgabebereich und der auch von dieser Tabelle aus gestartet wird, auch ohne VBA durch Eintragen der Werte in die entsprechenden Zeilen unterhalb der Kriterien weitaus schneller zum Ergebnis kommen könntest.

Einen ungetesteten Versuch, Deinen Code auf Find/FindNext anzupassen, findest Du hier. Probiere ihn bitte abnb einer Kopie Deiner Mappe aus:

Sub TextSuchen()

Dim strSuche As String
Dim rngZelle As Range
Dim strZelle As String
Dim wb As Workbook
Dim ws As Worksheet
Dim wsZiel As Worksheet
Dim lngStart As Long

strSuche = Worksheets("Auswertung").Range("G14").Value
If strSuche = "" Then Exit Sub

Application.ScreenUpdating = False
Set wb = GetObject("M:\L10\DB.xlsx")
Set ws = Workbooks("DB.xlsx").Worksheets("quelle")
Set wsZiel = Worksheets("Finder")

wsZiel.Cells.Value = ""
lngStart = 7

Set rngZelle = ws.Range("A:C").Find(strSuche)
If Not rngZelle Is Nothing Then
strZelle = rngZelle.Address
Do
rngZelle.EntireRow.Copy wsZiel.Rows(lngStart)
lngStart = lngStart + 1
Set rngZelle = ws.Range("A:C").FindNext(After:=rngZelle)
Loop While rngZelle.Address <> strZelle
End If

Set rngZelle = Nothing

Workbooks("ws.xlsx").Close
Application.ScreenUpdating = True

End Sub