Hallo zusammen
Und wieder ein Problem, was
ich nicht zusammenbringe.
Mit folgendem Code lasse ich mir die Fundstellen am aktiven Blatt "ausgeben"
PHP-Code:
Public Sub Vereinssuche()
Dim rngFind As Range
Dim strFirst As String
Dim strFindArray() As Variant
Dim intCount As Integer
strFindArray = Array("Schalke", "Bayern")
For intCount = 0 To UBound(strFindArray)
Set rngFind = Range("c2:c20").Find(what:=strFindArray(intCount), LookIn:=xlValues, LookAt:=xlPart)
If Not rngFind Is Nothing Then
strFirst = rngFind.Address
Do
Set rngFind = Range("c2:c20").FindNext(rngFind)
rngFind.Offset(0, 1) = "Gefunden"
rngFind.Offset(0, 1).Interior.ColorIndex = 7
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirst
End If
Set rngFind = Nothing
strFirst = vbNullString
Next
End Sub
Das funktioniert ganz gut. Ich will es aber schaffen, dass das Array aus einem Tabellenblatt ("Daten") eingelesen wird. Ich habe schon einiges probiert. Der Code liest mir aber immer nur die oberste Zelle ein
Das war mein letzte kläglicher Versuch
PHP-Code:
Public Sub Vereinssuche()
Dim rngFind As Range
Dim strFirst As String
Dim strFindArray() As Variant
Dim intCount As Integer
Dim spieler As Variant
spieler = Sheets("Daten").Range("B1:B5")
strFindArray = Array(spieler)
For intCount = 0 To UBound(strFindArray)
Set rngFind = Range("c2:c20").Find(what:=strFindArray(intCount), LookIn:=xlValues, LookAt:=xlPart)
If Not rngFind Is Nothing Then
strFirst = rngFind.Address
Do
Set rngFind = Range("c2:c20").FindNext(rngFind)
rngFind.Offset(0, 1) = "Gefunden"
rngFind.Offset(0, 1).Interior.ColorIndex = 7
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirst
End If
Set rngFind = Nothing
strFirst = vbNullString
Next
End Sub
Ich kämpfe schon (gefühlt seit 2020). Der Hintergrund für dieses Problem hat nichts mit Fussball zu tun, sondern mit meiner Arbeit. Ich will das Array aus der Tabelle holen, da die Daten ca. alle 2 bis 3 Monate geändert werden.
Vielleicht kann mir jemand helfen. Mir wäre schon mit einem Lösungsansatz geholfen
LG und danke
Michael
Moin,
mal schauen ob es ohne Datei geht. Was auffällt ist das du für den ersten Fund keine Aktion machst sondern nur das.
strFirst = rngFind.Address
Für die weiteren Funde machst du etwas.
rngFind.Offset(0, 1) = "Gefunden"
rngFind.Offset(0, 1).Interior.ColorIndex = 7
Edit: Da ist noch mehr.
Versuch mal den Code.
Code:
Public Sub Vereinssuche()
Dim rngFind As Range
Dim strFirst As String
Dim strFindArray As Variant
Dim intCount As Integer
Dim spieler As Variant
strFindArray = Sheets("Daten").Range("B1:B5").Value
For intCount = 1 To UBound(strFindArray)
Set rngFind = Range("c2:c20").Find(what:=strFindArray(intCount, 1), LookIn:=xlValues, LookAt:=xlPart)
If Not rngFind Is Nothing Then
strFirst = rngFind.Address
rngFind.Offset(0, 1) = "Gefunden"
rngFind.Offset(0, 1).Interior.ColorIndex = 7
Do
Set rngFind = Range("c2:c20").FindNext(rngFind)
rngFind.Offset(0, 1) = "Gefunden"
rngFind.Offset(0, 1).Interior.ColorIndex = 7
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirst
End If
Set rngFind = Nothing
strFirst = vbNullString
Next
End Sub
Gruß Elex
Hi Elex
Und das ohne Datei. Unglaublich. Das funktioniert. Ich habe das jetzt einfach rauskopiert und getestet. Ich werde mir heute Abend die Änderungen genauer ansehen.
Hab nur noch eine Frage. Wie kann ich verhindern, dass mir die leeren Zellen auch als Array bzw Fundstellen ausgegeben werden?
Habs auf die Schnelle ganz einfach gelöst. Ich habe im Blatt "Daten" die leeren Zellen mit einem Punkt gefüllt. Klappt wunderbar
Danke nochmal
LG
Michael
Das könnte man so Lösen.
Code:
Public Sub Vereinssuche()
Dim rngFind As Range
Dim strFirst As String
Dim strFindArray As Variant
Dim intCount As Integer
strFindArray = Sheets("Daten").Range("B1:B5").Value
For intCount = 1 To UBound(strFindArray)
If strFindArray(intCount, 1) <> "" Then
Set rngFind = Range("c1:c20").Find(what:=strFindArray(intCount, 1), LookIn:=xlValues, LookAt:=xlPart)
If Not rngFind Is Nothing Then
strFirst = rngFind.Address
rngFind.Offset(0, 1) = "Gefunden"
rngFind.Offset(0, 1).Interior.ColorIndex = 7
Do
Set rngFind = Range("c1:c20").FindNext(rngFind)
rngFind.Offset(0, 1) = "Gefunden"
rngFind.Offset(0, 1).Interior.ColorIndex = 7
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirst
End If
Set rngFind = Nothing
strFirst = vbNullString
End If
Next
End Sub
Etwas eleganter wäre es nicht mit festen Range Bereiche zu arbeiten, sondern sie automatisch zu ermitteln. Das geht aber nur mit fortlaufenden Listen wo die Lücken/Leerzellen nicht zwischen drin sind.
Gruß Elex
Danke nochmal
Das funktioniert sowas von perfekt. vbNullString kannte ich gar nicht.
Wegen der Leerzeichen. Ich kopiere die Daten von einer WordListe ins Blatt. Darum habe ich auch diese verfluchten leeren Zellen.
Die Datei ist für einen interne Wagenliste bei der Bahn.
Ein Beispiel
Wagen1 mit der Ordnungsnummer 1 fährt von München nach Dortmund, wird dort auf Zug BlaBla an 3. Stelle gehängt. Fährt dann von Dortmund nach Hamburg wird dort wieder umgehängt an Zug BlaBla an 10. Stelle usw. Darum brauche ich das Array (Die Ordnungsnummern bleiben immer gleich, nur die Reihungen und Züge ändern sich. Und es geht nicht um einen Waggon , sondern um mehrere.
Aus diesem Grund habe ich das Beispiel mit den Fussballspieler
Danke nochmal
Das ist sowas von perfekt
LG
Michael
Hoffentlich nicht sicherheitskritisch, so eine Wagennummer.
Nö
Wenn das sicherheitsrelevant wäre, würde ich das lassen.
Wir haben eigene Systeme dafür. Die ExcelDatei ist nur zum kontrollieren bzw als Vereinfachung zum eintragen
LG
Michael