Werte aus Zellen in "Value Like" übergeben

Forumthread: Werte aus Zellen in "Value Like" übergeben

02.10.2012 17:15:07

Micha

Hallo Excel Experten,
kann ich Werte aus einem Tabellenblatt auch verwenden um einen Suchlauf in einem anderen Tabellenblatt durchzuführen. Ich habe es mit Value like versucht. Funktioniert jedoch nicht wirklich, weil die Werte in A1 - C1 sich immer ändern. Hier ein Beispiel:

Sub WDVS()
Dim a As Long, i As Long
Application.ScreenUpdating = False
a = 5
For i = 1 To 10000
With Worksheets("Tabelle1")
If .Cells(i, "A").Value Like "035 W" And .Cells(i, "A").Value Like "stumpf" And .Cells(i, "A"). _
Value Like "*12*" Then
.Rows(i).Copy _
Destination:=Worksheets("Tabelle2").Rows(a)
a = a + 1
End If
End With
Next i
Application.ScreenUpdating = True
End Sub

Die Werte in A1 - C1 sollen jeweils vom User eingeben werden und sind demzufolge variabel. Im Beispiel steht in A1 "035 W", in B1 "stumpf" und in C1 "12". Diese Werte sollen jedoch veränderbar sein.
Nach diesen Werten soll in Tabelle1 gesucht werden und bei Übereinstimmung die gesamte Zeile aus Tabelle1 in Tabelle2 übernommen werden.
Ich möchte also immer nach den Werten suchen, die in A1 - C1 vorkommen.
Gibt es hierfür eine Lösung?
Vorab vielen Dank für die Hilfe
Gruß Micha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Werte aus Zellen in "Value Like" übergeben

03.10.2012 13:40:44

fcs

Hallo Micha,
du kannst die Suchbegriffe aus den Zellen in Tabelle2 in Variablen einlesen und dann entsprechend die Variablen in die If-Prüfungen einbauen.
Deine If-Prüfungen können aber so eigentlich kein Ergebnis True liefern, wenn du mit allen 3 Bedingen den Inhalt der Zellen in Spalte 1 (A) prüfst. entweder sind die Spalten falsch angegeben, oder die 3 Bedingungen müssen mit Or statt And verbunden werden.
Gruß
Franz

Sub WDVS()
Dim a As Long, i As Long
Dim Such_1 As String, Such_2 As String, Such_3 As String
Application.ScreenUpdating = False
a = 5
With Worksheets("Tabelle2")
Such_1 = .Cells(1, 1).Text
Such_2 = .Cells(1, 2).Text
Such_3 = "*" & .Cells(1, 3).Text & "*"
End With
For i = 1 To 10000
With Worksheets("Tabelle1")
If .Cells(i, 1).Value Like Such_1 _
And .Cells(i, 1).Value Like Such_2 _
And .Cells(i, 1).Value Like Such_3 Then
.Rows(i).Copy Destination:=Worksheets("Tabelle2").Rows(a)
a = a + 1
End If
End With
Next i
Application.ScreenUpdating = True
End Sub

AW: Werte aus Zellen in "Value Like" übergeben

04.10.2012 14:54:27

Micha

Hallo Franz,
danke für Deine Mühe, aber es funktioniert leider nicht.
Ein Or Abfrage kann ich nicht machen, weil alle 3 Bedingungen erfüllt sein müssen.
Gruß Micha

AW: Werte aus Zellen in "Value Like" übergeben

05.10.2012 04:57:28

fcs

Hallo Micha,
wenn alle 3 eingegebenen Werte jeweils in der Zelle in Spalte A vorkommen sollen, dann müssen die Suchbegriffe mit zusätzlichen "*" versehen werden. (Variante 1)
Wenn die Werte in Spalte A mit den ersten beiden Begriffen beginnen sollen, gefolgt vom 3. im restlichen Text dann muss du den Suchtext aus den 3 Werten zusammensetzen und vergleichen. (Variante 2)
Gruß
Franz
Beispiel:

Tabellenblattname: Tabelle1
A           B       C
1  035 Wstumpf 0123   1   Zeile 001
2     035 Wstumpf12   2   Zeile 002
3   038 Wstumpf0123   2   Zeile 003
4   035 Xstumpf0123   1   Zeile 004
5   135 Wstumpf0123   3   Zeile 005
6    035 Wstumpf011   4   Zeile 006
7    035 Wstiel0121   5   Zeile 007
8   A035 Wstumpf012   2   Zeile 008
9  035 Wsstumpfa012   3   Zeile 009
10  0d35 Wstumpf0123   1   Zeile 010

Ergebnis mit Makro Variante 1 (mit Variante 2 wird die letzte Zeile nicht kopiert):

Tabellenblattname: Tabelle2
A             B          C
1             035 W   stumpf          12
2
3
4
5  035 Wstumpf 0123        1   Zeile 001
6     035 Wstumpf12        2   Zeile 002
7  035 Wsstumpfa012        3   Zeile 009

Sub WDVS() 'Variante 1
Dim a As Long, i As Long
Dim Such_1 As String, Such_2 As String, Such_3 As String
Application.ScreenUpdating = False
a = 5
With Worksheets("Tabelle2")
Such_1 = .Cells(1, 1).Text & "*"
Such_2 = "*" & .Cells(1, 2).Text & "*"
Such_3 = "*" & .Cells(1, 3).Text & "*"
If .Cells(a, 1)  "" Then
.Range(.Cells(a, 1), .Cells(.Rows.Count, 1).End(xlUp)).EntireRow.Delete
End If
End With
With Worksheets("Tabelle1")
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(i, 1).Value Like Such_1 _
And .Cells(i, 1).Value Like Such_2 _
And .Cells(i, 1).Value Like Such_3 Then
.Rows(i).Copy Destination:=Worksheets("Tabelle2").Rows(a)
a = a + 1
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Sub WDVS2() 'Variante 2
Dim a As Long, i As Long
Dim Such_1 As String
Application.ScreenUpdating = False
a = 5
With Worksheets("Tabelle2")
Such_1 = .Cells(1, 1).Text & .Cells(1, 2).Text & "*" & .Cells(1, 3).Text & "*"
If .Cells(a, 1)  "" Then
.Range(.Cells(a, 1), .Cells(.Rows.Count, 1).End(xlUp)).EntireRow.Delete
End If
End With
With Worksheets("Tabelle1")
For i = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(i, 1).Value Like Such_1 Then
.Rows(i).Copy Destination:=Worksheets("Tabelle2").Rows(a)
a = a + 1
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

AW: Werte aus Zellen in "Value Like" übergeben

05.10.2012 07:43:19

Micha

Hallo Franz,
danke, danke, danke Variante 1 funktioniert!!!!!
Allerdings musste ich meine Suchabfrage verändern. Der Wert 035 steht nicht an 1. Stelle im gesuchten Text. D.h. merkwürdiger Weise geht es nur, wenn ich die 1. Stelle im gesuchten Text mit angebe. Ich werde daher noch eine 4. Abfrage hinzufügen müssen.
Nochmals herzlichen Dank für Deine SUPER Arbeit!!!
PS: Variante 2 schaue ich mir auch noch an.
Gruß Micha

AW: Werte aus Zellen in "Value Like" übergeben

05.10.2012 13:06:39

fcs

Hallo Micha,
wenn der 1. Suchbegriff nicht am Anfang steht, dann muss du im Code bei der Berechnung des Suchbegriffs auch noch die Wildcard "*" einbauen. Wie bei den anderen beiden Suchbegriffen.
Gruß
Franz

AW: Werte aus Zellen in "Value Like" übergeben

05.10.2012 16:31:36

Micha

Hallo Franz,
das habe ich zwischenzeitlich auch schon gemerkt und auch eingefügt. Jetzt ist es so wie ich es haben wollte. Nochmals vielen, vielen Dank und ein schönes Wochenende.
Gruß Micha

AW: Werte aus Zellen in "Value Like" übergeben

03.10.2012 14:09:23

Tino

Hallo,
hier mal eine Variante

Sub WDVS()
Dim a&, n&
Dim rngSuchBereich As Range, rngValue As Range, rngTmp As Range
'Suchbereich, Tabelle und Spalte angeben 
Set rngSuchBereich = Worksheets("Tabelle2").Columns(1)
'Suchwerte, Tabelle und Zellen angeben 
Set rngValue = Worksheets("Tabelle1").Range("A1:C1")
'erste Einfügezeile 
a = 5

Application.ScreenUpdating = False

With Worksheets("Tabelle1") 'Ziel Tabelle 
    .Range(.Cells(a, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
    For Each rngValue In rngValue
        Set rngTmp = FindDaten(rngValue.Value, rngSuchBereich)
        If Not rngTmp Is Nothing Then
            For Each rngTmp In rngTmp.Areas
                rngTmp.EntireRow.Copy .Cells(a, 1)
                a = a + rngTmp.Rows.Count
            Next rngTmp
            Set rngTmp = Nothing
        End If
    Next rngValue
End With

Application.ScreenUpdating = True
End Sub

Function FindDaten(strSuchbegriff, rngSuchBereich) As Range
Dim strErste$, rngTmp As Range, rngAusgabe As Range

Set rngTmp = rngSuchBereich.Find(What:=strSuchbegriff, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
If rngTmp Is Nothing Then Exit Function
Set rngAusgabe = rngTmp
strErste = rngTmp.Address
Set rngTmp = rngSuchBereich.FindNext(rngTmp)
Do While strErste <> rngTmp.Address
  Set rngAusgabe = Union(rngAusgabe, rngTmp)
  Set rngTmp = rngSuchBereich.FindNext(rngTmp)
Loop
Set FindDaten = rngAusgabe
End Function

Gruß Tino

AW: Werte aus Zellen in "Value Like" übergeben

04.10.2012 14:58:47

Micha

Hallo Tino,
vielen Dank für Deine Mühe, aber es funktioniert leider nicht.
Es werden im Tabellenblatt 1 die ersten 3 Zellen angezeigt - ohne Bezug auf meine Eingaben.
Da werde ich noch etwas dran feilen müssen. Von Ansatz her sah es sehr gut aus.
Gruß MIcha

Beliebteste Forumthreads (12 Monate)

Werte aus Zellen in "Value Like" übergeben

Forumthread: Werte aus Zellen in "Value Like" übergeben

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Werte aus Zellen in "Value Like" übergeben

Forumthread: Werte aus Zellen in "Value Like" übergeben

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread