Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA-Lösung suchen / eintragen

VBA-Lösung suchen / eintragen
Franz
Hallo zusammen,
benötige die Hilfe eines VBA-Experten.
Ich habe eine Ausgangstabelle mit den Spalten A bis G. Dort befinden sich Namen. Diese Namen sollen in der Suchtabelle auf Übereinstimmung geprüft werden. Es zählt nur, ob diese Namen in der Suchtabelle in einer Zeile gefunden werden.
Wenn ja, dann soll in Spalte H der Ausgangstabelle der Wert aus Spalte A der Suchtabelle wieder gegeben werden. Wird der Wert gefunden, so soll direkt die nächste Zeile der Ausgangstabelle in der Suchtabelle gefunden werden. Procedere das gleiche.
Die Schleife soll alle Zeilen in der Ausgangstabelle abklappern.
Eine Datei zur Veranschaulichung anbei.
https://www.herber.de/bbs/user/75924.xls
Kann mir jemand helfen?
Gruß und danke vorab
Franz Kupfer

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: VBA-Lösung suchen / eintragen
28.07.2011 19:25:15
Franz
Ach so: die Reihenfolge der Namen in der Ausgangstabelle und Suchtabelle spielt keine Rolle.
Die Namen aus der Ausgangstabelle müssen lediglich in der Suchtabelle in einer Zeile vorkommen, dann den Wert ausgeben und nächste Namenliste suchen.
AW: VBA-Lösung suchen / eintragen
28.07.2011 21:53:34
fcs
Hallo Franz,
hier eine Lösung mit benutzerdefinierter Funktion.
Die Function muss du in ein allgemeines Modul der Datei kopieren.
Gruß
Franz
Ausgangstabelle

 ABCDEFGH
1Name1Name2Name3Name4Name5Name6Name7Bereich
2FranzHelmutMarkus    GL
3OttoHannelorePetra    nix gefunden
4FranzSabine     SIEL

Formeln der Tabelle
ZelleFormel
H2=fncSUcheSpezial(A2:G2;Suchtabelle!$A$2:$A$5;Suchtabelle!$AF$2:$AL$5)
H3=fncSUcheSpezial(A3:G3;Suchtabelle!$A$2:$A$5;Suchtabelle!$AF$2:$AL$5)
H4=fncSUcheSpezial(A4:G4;Suchtabelle!$A$2:$A$5;Suchtabelle!$AF$2:$AL$5)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Public Function fncSucheSpezial(Suchwerte As Range, Ergebniswerte As Range, _ Vergleichswerte As Range) As String 'Sucht die Suchwerte in den Spalten 2 bis x von Vergleichswerte _ Werden alle Suchwerte in einer Zeile von Vergleichswerte gefunden, dann wird _ der Wert aus der 1. Spalte der Zeile von Vergleichswerte zurückgegeben Dim Zeile As Long, Spalte As Long, Bereich As Range, bAlle As Boolean Dim vSpalte, vWert fncSucheSpezial = "nix gefunden" 'Ergebnis, wenn keine Übereinstimung gefunden wurde For Zeile = 1 To Vergleichswerte.Rows.Count bAlle = True With Vergleichswerte Set Bereich = Range(.Cells(Zeile, 1), .Cells(Zeile, .Columns.Count)) End With For Spalte = 1 To Suchwerte.Columns.Count vWert = Suchwerte.Cells(1, Spalte).Value If vWert "" Then vSpalte = Application.Match(vWert, Bereich, 0) If IsError(vSpalte) Then bAlle = False: Exit For End If Next Spalte If bAlle = True Then fncSucheSpezial = Ergebniswerte.Cells(Zeile, 1).Value Exit Function End If Next Zeile End Function
Anzeige
AW: VBA-Lösung suchen / eintragen
28.07.2011 22:04:30
wolfgang
Hallo Franz
Hier mal ein Ansatz mit einer Funktion
Hat bei mir funktioniert wenn man als Bereich der Arbeitsmappe"Suchtabelle" den Bereich A:AL !! markiert
( in deinem Bereich B:AE steht ja nix drin !!)
Die Zeilen der Suchbereiche müssen auch übereinstimmen
(Also Zeile Ausgangstabelle wird mit der Zeile Suchtabelle verglichen)
Function Test(rngZellen As Range, suchZellen As Range) As Variant
Dim i, k
Dim a, b
Test = "nix gefunden"
For i = 1 To rngZellen.Columns.Count
If rngZellen(i)  "" Then
a = rngZellen(i)
For k = 1 To suchZellen.Columns.Count
b = suchZellen(k)
If a = b Then
Test = suchZellen(1)
GoTo ende
End If
Next k
End If
Next i
ende:
End Function
gruß wolfgang
Anzeige
AW: VBA-Lösung suchen / eintragen
29.07.2011 18:45:29
Franz
Hallo zusammen,
leider konnte ich mir Eure Lösungen erst jetzt anschauen, weil ich arbeiten musste. :-(
Eine Lösung ist nicht so richtig dabei. Vermutlich habe ich mich als Laie auch falsch ausgedrückt.
Ausgangssituation:
Ich habe eine Zeile (A2:G2 und folgende) der Ausgangstabelle. Die dort enthaltenen Werte z.B. Franz Helmut Markus
müssen in der gesamten Suchtabelle im Bereich AF:AL gesucht werden. Sobald die erste Übereinstimmung gefunden wird, soll der Wert aus der Zelle A der jeweilgen Zeile (z.B. A500) in die Zelle H der entsprechenden Ausgangstabelle geschrieben werden. Und dann wird die nächste Zeile der Ausgangstabelle in der Suchtabelle abgeglichen und so weiter.
Beispiel:
Ausgangstabelle
Zeile 3
Begriffe Hans Peter Fritz
suchen in der
Suchtabelle
Bereich AF2:AL...
wenn gefunden, Wert aus Zelle A der jeweiligen Zeile in Ausgangstabelle H der entsprechenden Zelle eintragen und Werte aus der nächsten Zeile suchen.
Franz: In die gleiche Richtung (fast) geht es m.E. bei dem Beitrag von Claudia, bei dem Du geholfen hast.
https://www.herber.de/forum/archiv/1220to1224/t1223263.htm#1223613
M.E. geht das nur mit VBA? Ich denke ich habe mich hier vollkommen blöde ausgedrückt.
Was meint Ihr? Kann man mir noch helfen?
Gruß und danke!
Franz Kupfer
Anzeige
AW: VBA-Lösung suchen / eintragen
29.07.2011 19:50:00
fcs
Hallo namensvetter,
mein Vorschlag ist eine VBA-Lösung, die hier als Tabellenformel benutzt wird.
Da meine Funktion das von dir in der Beispieltabelle angegebene Ergebnis anzeigt, weiss ich nicht wo nun das Problem ist. Wenn du jetzt mehr Zeilen in der Suchtabelle hast, dann muss du in den Formeln natürlich die Zeilenwerte anpassen.
aus
=fncSUcheSpezial(A2:G2;Suchtabelle!$A$2:$A$5;Suchtabelle!$AF$2:$AL$5)
wird dann z.B.
=fncSUcheSpezial(A2:G2;Suchtabelle!$A$2:$A$1250;Suchtabelle!$AF$2:$AL$1250)

Die Rechenzeit geht dann natürlich entsprechend hoch.
Nachfolgend eine VBA-Lösung, die die gleiche Berechnungsmethode verwendet und die Ergebnisse in Spalte H der Ausgangstabelle einträgt.
Deine neuen/ergänzenden Beschreibungen zum Problem sind leider nicht klarer als in der ursprünglichen Frage.
Gruß
Franz
Sub TrefferSuche()
Dim wksAusgang As Worksheet, wksSuch As Worksheet
Dim Zeile As Long, ZeileL As Long
Dim rErgebnis As Range, rSuchen As Range
Set wksAusgang = Worksheets("Ausgangstabelle")
Set wksSuch = Worksheets("Suchtabelle")
With wksSuch
'Letzte Datenzeile in Spalte A
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
'Ergebnis-Daten in Spalte A
Set rErgebnis = .Range(.Cells(2, 1), .Cells(ZeileL, 1))
'Suchdaten in Spalten AF (32) bis AL (38)
Set rSuchen = .Range(.Cells(2, 32), .Cells(ZeileL, 38))
End With
With wksAusgang
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
For Zeile = 2 To ZeileL
.Cells(Zeile, 8) = fncSucheSpezial(Suchwerte:=.Range(.Cells(Zeile, 1), .Cells(Zeile, 7)),  _
_
Ergebniswerte:=rErgebnis, Vergleichswerte:=rSuchen)
Next
End With
End Sub
Public Function fncSucheSpezial(Suchwerte As Range, Ergebniswerte As Range, _
Vergleichswerte As Range) As String
'Sucht die Suchwerte in den Zeilen von Vergleichswerte _
Werden alle Suchwerte in einer Zeile von Vergleichswerte gefunden, dann wird _
der Wert aus der Ergebniswerte zurückgegeben
Dim Zeile As Long, Spalte As Long, Bereich As Range, bAlle As Boolean
Dim vSpalte, vWert
fncSucheSpezial = "nix gefunden" 'Ergebnis, wenn keine Übereinstimung gefunden wurde
For Zeile = 1 To Vergleichswerte.Rows.Count
bAlle = True
With Vergleichswerte
Set Bereich = Range(.Cells(Zeile, 1), .Cells(Zeile, .Columns.Count))
End With
For Spalte = 1 To Suchwerte.Columns.Count
vWert = Suchwerte.Cells(1, Spalte).Value
If vWert  "" Then
vSpalte = Application.Match(vWert, Bereich, 0)
If IsError(vSpalte) Then bAlle = False: Exit For
End If
Next Spalte
If bAlle = True Then
fncSucheSpezial = Ergebniswerte.Cells(Zeile, 1).Value
Exit Function
End If
Next Zeile
End Function

Anzeige
AW: VBA-Lösung suchen / eintragen
29.07.2011 20:57:22
Franz
Hallo Franz,
funktioniert wie gewünscht. Ich habe es wohl nur nicht geschnallt.
Nutze nun aber das Makro, ist einfacher. :-)
Besten Dank für die Hilfe!
Schönes Wochenende
Franz

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige