Doppelte Spaltenüberschrift finden

L

Lolasun

Grünschnabel
Hallo,

ich habe eine Exceldatei in der ich die Spalte mit einer bestimmten Überschrift suche.
Leider gibt es keine Garantie, dass diese Überschrift nur einmal existiert.

Zur Zeit benutze ich die Suche:


Function findCol(SheetName, SearchRow1, SearchRow2, FindStr)
rngStr = SearchRow1 & ":" & SearchRow2

With Sheets(SheetName).Range(rngStr)
Set rng = .Find(What:=FindStr, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
foundCell = rng.Address
foundCol = Range(foundCell).Column
Application.Goto rng, True
End If
End With
findCol = foundCol
End Function[

Leider bricht die Suche bei dem ersten gefundenen Suchwort ab.
Wie kann ich denn die 2. Spalte oder die letzte Spalte mit dem gleichen Suchwort finden?

Hat jemand vielleicht einen Tipp für mich?
Vielen Dank im Vorraus,
Lola
 
Hallo Lola,

schaue einmal in der Online-Hilfe unter: „Find-Methode“ und von dort unter: „FindNext“.

Viel Erfolg
Walter Gutermann
 
Hallo Walter,

Danke für deine Antwort.
Ich habe dieses Beispiel in der Hilfe gefunden:
Code: 
With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Interior.Pattern = xlPatternGray50
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

Leider habe ich es noch nicht geschafft mir dann die Addresse der zuletzt gefundenen RangeObjekts zurückgeben zu lassen.
FindNext() liefert IMO nur true zurück.

Ich habe versucht in After:=Myfind() meine oben beschriebene Findmethode aufzurufen, aber das geht ebenfalls nicht.

Ich weiß wirklich nicht mehr weiter...

viele Grüße, Lola
 
Hallo Lola,
ich hatte dem Beispiel ungetestet vertraut. Aber das taugt wohl nicht richtig.
Eine Lösungsmöglichkeit ist zum Beispiel:

Code: 
Option Explicit
Type Ergebnis
  iZeile As Integer
  iSpalte As Integer
  sTxt As String
End Type
Dim mErgebnis() As Ergebnis

Sub test()
  Dim i As Integer
  Dim iTreffer As Integer
  Dim sErgebnis As String
  Dim iZeileUe As Integer   ' Zeile mit den Überschriften
  Dim iSvon As Integer      ' erste Spalte in der gesucht werden soll
  Dim iSbis As Integer      ' letzte Spalte in der gesucht werden soll
  Dim sUber As String       ' gesuchte Überschrift
  Dim mWs As Worksheet      ' das Tabellenblatt
  
  iZeileUe = 1                              ' <-- Deine Werte
  iSvon = 1                                 ' <-- Deine Werte
  iSbis = 10                                ' <-- Deine Werte
  sUber = "hier die gesuchte Überschrift"   ' <-- Deine Werte
  Set mWs = Worksheets(1)                   ' <-- Deine Werte
  
  iTreffer = findUberschrift(mWs, iZeileUe, iSvon, iSbis, sUber)
  If iTreffer > 0 Then
    For i = 1 To UBound(mErgebnis())
      sErgebnis = sErgebnis & "Zeile: " & mErgebnis(i).iZeile & ", Spalte: " & mErgebnis(i).iSpalte & ", Text: " & mErgebnis(i).sTxt & vbLf & vbCr
    Next i
    MsgBox "Die Überschrift: " & sUber & " wurde " & iTreffer & "mal gefunden!" & vbLf & vbCr & vbLf & vbCr & sErgebnis
  Else
    MsgBox "Die Überschrift: " & sUber & " wurde nicht gefunden!"
  End If
  Set mWs = Nothing
End Sub

Function findUberschrift(mWs As Worksheet, iZeile As Integer, iSpalteVon As Integer, iSpalteBis As Integer, sSuch As String) As Integer
  Dim iZSpalte          ' Zähler Spalten
  findUberschrift = 0
  With mWs
    For iZSpalte = iSpalteVon To iSpalteBis
      If .Cells(iZeile, iZSpalte).Value = sSuch Then
        findUberschrift = findUberschrift + 1
        ReDim Preserve mErgebnis(findUberschrift)
        mErgebnis(findUberschrift).iSpalte = iZSpalte
        mErgebnis(findUberschrift).iZeile = iZeile
        mErgebnis(findUberschrift).sTxt = .Cells(iZeile, iZSpalte).Value
      End If
    Next iZSpalte
  End With
End Function


Ich hoffe Du kannst das Makro für Deine Bedürfnisse anpassen.

Viel Erfolg
Walter Gutermann
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück