Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

range("XXX").Find x-tes Auftreten Arg.

Betrifft: range("XXX").Find x-tes Auftreten Arg. von: Peter
Geschrieben am: 17.08.2020 14:22:44

Guten Tag

Mit dieser Funktion suche ich in einer Spalte nach dem Argument strFind


Nun könnte das Argument mehrmals auftauchen. Wie kann ich beispielsweise das zweite Auftreten des Arguments auslesen?


Gruss, Peter



Function FindValue1(strSheet As String, lngCol As Long, lngColOut As Long, strFind As String)    _
 _
 _
_
_
As String
   Dim lRow As Long, rngData As Range, rngFund As Range
   
   lRow = Sheets(strSheet).Cells(Rows.Count, lngCol).End(xlUp).Row
   Set rngData = Sheets(strSheet).Range(spBuchstabe(lngCol) & "1:" & spBuchstabe(lngCol) & lRow) _
 _
 _
 _
 _
.Find(strFind, LookIn:=xlValues, lookat:=xlWhole)
 
   If Not rngData Is Nothing Then
   Set rngData = rngData.Offset(0, lngColOut - lngCol)
    FindValue1 = "'" & rngData.Parent.Name & "'!" & rngData.Address(0, 0)
    
   Else
    FindValue1 = ""
   End If
End Function



Function spBuchstabe(Spalte As Long) As String

Dim rg As String

rg = Cells(1, Spalte).Address(True, False)

spBuchstabe = Left(rg, InStr(1, rg, "$") - 1)

End Function

Betrifft: AW: range("XXX").Find x-tes Auftreten Arg.
von: volti
Geschrieben am: 17.08.2020 15:51:17

Hallo Peter,

hier ein Beispiel, wie Du alle Felder im angegebenen Range (hier Spalte B) finden kannst, in denen der Suchbegriff steht.

Vielleicht hilft Dir dies ja weiter:

Code in die Zwischenablage[+][-]
Sub Test_SucheInB() MsgBox FindValue1(ActiveSheet.Name, 2, 2, "a_Mailversand") End Sub Function FindValue1(strSheet As String, lngCol As Long, lngColOut As Long, strFind As String) As String Dim lRow As Long, rngData As Range, oFinde As Object, sErsteAdresse As String lRow = Sheets(strSheet).Cells(Sheets(strSheet).Rows.Count, lngCol).End(xlUp).Row Set rngData = Sheets(strSheet).Range(spBuchstabe(lngCol) & "1:" & spBuchstabe(lngCol) & lRow) Set oFinde = rngData.Find(strFind, LookIn:=xlValues, lookat:=xlWhole) If Not oFinde Is Nothing Then sErsteAdresse = oFinde.Address Do With oFinde FindValue1 = FindValue1 & .Address & ", " End With Set oFinde = rngData.FindNext(oFinde) Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse End If End Function Function spBuchstabe(Spalte As Long) As String Dim rg As String rg = Cells(1, Spalte).Address(True, False) spBuchstabe = Left(rg, InStr(1, rg, "$") - 1) End Function
viele Grüße aus Freigericht
Karl-Heinz


Betrifft: AW: range("XXX").Find x-tes Auftreten Arg.
von: Peter
Geschrieben am: 17.08.2020 17:41:16

Hallo Karl-Heinz
Das ist ja viel versprechend. Vielen Dank. Die MsgBox gibt die gewünschte Ausgabe. Jetzt muss ich das für meine Bedürfnisse anpassen.
Ich blick da bei oFinde respektive beim Loop noch nicht ganz durch.
Was ist oFinde genau für ein Objekt? Und wie genau läuft es, dass ich dann die zweite Fundstelle mittels Adresse identifizieren kann?
Könntest du mir den Code ab der Zeile "Do" erklären?
Vielen Dank und Gruss, Peter

Betrifft: AW: "Kleiner Nachtrag"
von: Peter
Geschrieben am: 17.08.2020 17:53:46

Hallo Karl-Heinz
Wie man meinem Code ansieht, habe ich noch nicht ganz begriffen, wie das läuft.
Als Zwischenergebnis möchte ich gerne 4 Adressen (mehr hat es hier nie) abfragen, hat es weniger, sollte die Variabel leer bleiben.
Ich brauche also ein Ergebnis für s1Adresse, s2Adresse, s3Adresse und s4Adresse.

Vielen Dank.

Freundlicher Gruss, Peter

Function FindValueX(strSheet As String, lngCol As Long, lngColOut As Long, strFind As String)  _
As String
   Dim lRow As Long, rngData As Range, oFinde As Object, s1Adresse As String, s2Adresse As  _
String
   Dim s3Adresse As String, s4Adresse As String
   
   lRow = Sheets(strSheet).Cells(Sheets(strSheet).Rows.Count, lngCol).End(xlUp).Row
   Set rngData = Sheets(strSheet).Range(spBuchstabe(lngCol) & "1:" & spBuchstabe(lngCol) & lRow) _

   
   Set oFinde = rngData.Find(strFind, LookIn:=xlValues, lookat:=xlWhole)
   If Not oFinde Is Nothing Then
      s1Adresse = oFinde.Address
      s2Adresse = rngData.FindNext(oFinde).Address
      s3Adresse = rngData.FindNext(oFinde).Address
      s4Adresse = rngData.FindNext(oFinde).Address
      ''' mehr als 4 gleiche hat es nie ...
      
      Do
         With oFinde
            FindValueX = FindValueX & .Address & ", "
         End With
         Set oFinde = rngData.FindNext(oFinde)
      Loop While Not oFinde Is Nothing And oFinde.Address <> s1Adresse
   End If
 
End Function


Betrifft: AW: "Kleiner Nachtrag"
von: volti
Geschrieben am: 17.08.2020 20:00:21

Hallo Peter,

mit

Set oFinde = rngData.Find(strFind, LookIn:=xlValues, lookat
wird ein Objekt erstellt, in dem bei Erfolg die Parameter der Fundstelle enthalten sind (hätte auch ein Range sein können)
Wir gehen dann in eine Do/Loop-Schleife und holen uns mittels .Findnext ausgehend von der letzten Fundstelle die nächste Fundstelle usw..
Falls alle Fundstellen durch sind, fängt Excel wieder von vorne an, deshalb hatten wir uns vor dem Do die Adresse der ersten Fundstelle gemerkt und wenn diese Adresse wieder auftaucht springen wir aus der Do/Loop-Schleife raus und sind fertig.

Innerhalb der WITH-Klausel kann dann etwas mit der Fundstelle gemacht werden. Ich habe hier einfach die Adressen (Range) der Fundstellen zur Ausgabe in einen String aufkumuliert.

Ich würde jetzt die Suche als Funktion nutzen. Test_SucheInB wäre jetzt Dein Hauptprogramm, wo Du die Adressen benötigst.
Auch würde ich mit einem Array arbeiten. Falls Du unbedingt vier Einzelvariablen verwenden möchtest, mache es so wie im Beispiel.

Oder nimm die zweite Variante, die mehr wie Deine Version aussieht.


Code in die Zwischenablage[+][-]
Sub Test_SucheInB() Dim sArrAdr() As String Dim s1Adresse As String, s2Adresse As String Dim s3Adresse As String, s4Adresse As String sArrAdr = Split(FindValue1(ActiveSheet.Name, 2, 2, "SuchMich") & ",,,,,", ",") s1Adresse = sArrAdr(0) s2Adresse = sArrAdr(1) s3Adresse = sArrAdr(2) s4Adresse = sArrAdr(3) End Sub Function FindValue1(strSheet As String, lngCol As Long, lngColOut As Long, strFind As String) As String Dim lRow As Long, rngData As Range, oFinde As Object, sErsteAdresse As String lRow = Sheets(strSheet).Cells(Sheets(strSheet).Rows.Count, lngCol).End(xlUp).Row Set rngData = Sheets(strSheet).Range(spBuchstabe(lngCol) & "1:" & spBuchstabe(lngCol) & lRow) Set oFinde = rngData.Find(strFind, LookIn:=xlValues, lookat:=xlWhole) If Not oFinde Is Nothing Then sErsteAdresse = oFinde.Address Do With oFinde FindValue1 = FindValue1 & .Address & "," End With Set oFinde = rngData.FindNext(oFinde) Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse End If End Function Function spBuchstabe(Spalte As Long) As String Dim rg As String rg = Cells(1, Spalte).Address(True, False) spBuchstabe = Left(rg, InStr(1, rg, "$") - 1) End Function Function FindValue2(strSheet As String, lngCol As Long, lngColOut As Long, strFind As String) As String Dim lRow As Long, i As Integer Dim rngData As Range, oFinde As Object, sErsteAdresse As String Dim s1Adresse As String, s2Adresse As String Dim s3Adresse As String, s4Adresse As String lRow = Sheets(strSheet).Cells(Sheets(strSheet).Rows.Count, lngCol).End(xlUp).Row Set rngData = Sheets(strSheet).Range(spBuchstabe(lngCol) & "1:" & spBuchstabe(lngCol) & lRow) Set oFinde = rngData.Find(strFind, LookIn:=xlValues, lookat:=xlWhole) If Not oFinde Is Nothing Then sErsteAdresse = oFinde.Address i = i + 1 Do With oFinde Select Case i Case 1: s1Adresse = .Address Case 2: s2Adresse = .Address Case 3: s3Adresse = .Address Case 4: s4Adresse = .Address End Select i = i + 1 End With Set oFinde = rngData.FindNext(oFinde) Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse End If End Function
viele Grüße aus Freigericht
Karl-Heinz


Betrifft: AW: "Kleiner Nachtrag"
von: Peter
Geschrieben am: 18.08.2020 07:23:59

Guten Tag Karl-Heinz
Vielen Dank für die anschauliche Erklärung.
Ich gehe mal davon aus, dass ich damit meine Lösung bauen kann.
Sonst würde ich mir erlauben, nochmals "anzuklopfen" (nachzufragen).
Gruss, Peter

Betrifft: AW: Noch nicht ganz am Ziel ...
von: Peter
Geschrieben am: 22.08.2020 13:16:00

Hallo Karl-Heinz
Ich konnte mich jetzt nochmals mit dem Code beschäftigen. Ich habe eine Beispieldatei mit Code hochgeladen und beschreibe das Zwischenergebnis:
Wenn ich den Sub Suche_in_Tabelle ausführe, ergeben die Variablen s1Adresse, s2Adresse, s3Adresse un s4Adresse die gesuchten Zelladressen als String.
Was ich nicht geschafft habe, ist diesen Sub in 4 Funktionen umzuwandeln, mit denen ich dann die einzelnen Strings in einer Tabelle abfragen kann.

In meiner Beispieldatei sind die Register "Afrage" und "Quelle" enthalten. Die Struktur der Tabelle Quelle bleibt zwar immer gleich, die gesuchten Ergebnisse sind jedoch nicht immer in der gleichen Zeile enthalten, manchmal sind auch nur 2 oder 3 Zeilen abgefüllt, maximal jedoch 4.

Relevante Zeilen haben einen bestimmten Inhalt, hier den String "Apfel".
Ich möchte nun in der Tabelle "Abfrage" mittels Funktion die zutreffenden Zeilen aus Tabelle Quelle abfragen.
Wenn ich mit der einer Funktion in den Zellen A6:E9 die relevanten Zellen aus Worksheet "Quelle" abfragen kann, ist es dann ein kleines diese Ergebnisse mit einer Formel so zu erweitern, dass letztlich die gewünschten Werte in den Zellen stehen.

Natürlich würde ich die Argumente, die aktuell in der Zeile
sArrAdr = Split(FindValue1("Quelle", 5, 2, "Apfel") & ",,,,,", ",")
stehen, der gesuchten Funktion übergeben:
=gesuchteFunktion(1,"Quelle", 5, Spalte(), "Apfel")
=gesuchteFunktion(2,"Quelle", 5, Spalte(), "Apfel")
=gesuchteFunktion(3,"Quelle", 5, Spalte(), "Apfel")
=gesuchteFunktion(4,"Quelle", 5, Spalte(), "Apfel")

wobei das erste Argument, das xte Vorkommen des vierten Arguments in der Tabelle "Quelle" meint.

Wäre super, wenn das klappen würde. Vielen Dank für die Hilfe.

Gruss, Peter

https://www.herber.de/bbs/user/139776.xlsm

Betrifft: AW: Noch nicht ganz am Ziel ...
von: volti
Geschrieben am: 22.08.2020 16:32:54

Hallo Peter,

ich kann Dir irgendwie nicht richtig folgen, auch nicht mit der Beispielmappe.
Möchtest Du eine Funktion, in der Du die Fundnummer vorgeben kannst?

Vielleicht so etwas wie im u.a. Code.

Den kann man auch als Formel im Excelblatt verwenden. (Findet bei mir aber immer nur den ersten Wert und ich nicht den Fehler)

Code in die Zwischenablage[+][-]
Function GesuchteFunktion(iNr As Integer, strSheet As String, lngCol As Long, _ lngColOut As Long, strFind As String) As Variant Dim lRow As Long, rngData As Range, oFinde As Object, sErsteAdresse As String With ThisWorkbook.Sheets(strSheet) lRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row With .Range(.Cells(1, 5), .Cells(lRow, 5)) Set oFinde = .Find(strFind, LookIn:=xlValues, lookat:=xlWhole) If Not oFinde Is Nothing Then sErsteAdresse = oFinde.Address Do i = i + 1 With oFinde.Offset(0, lngColOut - lngCol) If i = iNr Then GesuchteFunktion = .Value: Exit Function End With Set oFinde = .FindNext(oFinde) Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse End If End With End With End Function Sub Test() MsgBox GesuchteFunktion(1, "Quelle", 5, 2, "Apfel") End Sub
viele Grüße aus Freigericht
Karl-Heinz


Betrifft: AW: Noch nicht ganz am Ziel ...
von: Peter
Geschrieben am: 23.08.2020 00:23:12

Hallo Karl-Heinz

Vielen Dank. Die Funktion macht genau, was ich brauche, obschon die Auswertung nur für Zeile 1 klappt.
Interessant ist, dass die Funktion alle Ergebnisse liefert, wenn sie über die Messagebox (vgl. < _ pre> Sub Test) aufgerufen wird. Das ist ja schon eigenartig, dass eine diese Funktion funktioniert, _ wenn sie über einen
Sub aufgerufen wird, wenn die Eingabe der Funktion in der Tabelle erfolgt, dass dann alle  _
Ergebnisse die über .FindNext aufgerufen werden, nicht eingetragen werden können.
Die Funktion muss ja identifizieren, auf welchen Zeilen in Worksheet "Quelle" in Spalte E " _
Apfel" steht und von diesen Zeilen müssen dann die Werte der Spalten A, B, C, D und E im Bereich A5:E9 eingetragen werden (gemäss hochgeladener Beispielmappe).
Da der erste Eintrag dieses Threads schon recht alt ist, wird der Thread dann bald im Archiv  _
landen. Sobald das passiert, werde ich möglicherweise nochmals einen neuen Eintrag machen - vielleicht hat ja noch sonst jemand eine Idee, was hier das Problem ist, dass es teils funktioniert und teils nicht.

Gruss, Peter


Function FindValue(iNr As Integer, strSheet As String, lngCol As Long, _
                          lngColOut As Long, strFind As String) As Variant
  Dim lRow As Long, rngData As Range, oFinde As Object, sErsteAdresse As String, i As Long
 
  With ThisWorkbook.Sheets(strSheet)
    lRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row
    With .Range(.Cells(1, 5), .Cells(lRow, 5))
      Set oFinde = .Find(strFind, LookIn:=xlValues, lookat:=xlWhole)
      If Not oFinde Is Nothing Then
         sErsteAdresse = oFinde.Address
         Do
            i = i + 1
            With oFinde.Offset(0, lngColOut - lngCol)
              If i = iNr Then FindValue = .Value: Exit Function
            End With
            Set oFinde = .FindNext(oFinde)
         Loop While Not oFinde Is Nothing And oFinde.Address <> sErsteAdresse
      End If
    
    End With
  End With
  
End Function

Sub Test()
MsgBox FindValue(1, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 1, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 2, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 3, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 4, "Apfel")
MsgBox FindValue(1, "Quelle", 5, 5, "Apfel")
MsgBox FindValue(2, "Quelle", 5, 5, "Apfel")
MsgBox FindValue(3, "Quelle", 5, 5, "Apfel")
MsgBox FindValue(4, "Quelle", 5, 5, "Apfel")

End Sub
In der Tabelle (Beispiel Spalte A) sehen eingetragenen Funktionen mit den Argumenten wie Folgt aus:
=FindValue(1;"Quelle";5;SPALTE();"Apfel")
=FindValue(2;"Quelle";5;SPALTE();"Apfel")
=FindValue(3;"Quelle";5;SPALTE();"Apfel")
=FindValue(4;"Quelle";5;SPALTE();"Apfel")
Da es vorkommen kann, dass der gesuchte Wert nicht viermal vorkommt, werde ich einen möglichen Fehler mit der Funktion WENNFEHLER abfangen.