Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1376to1380
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Find Range Union Problem

Find Range Union Problem
19.08.2014 13:35:56
BinärCode
Gute Tag,
ich bin relativ neu mit VBA unterwegs und bin leider auf folgendes Problem gestoßen.
Ich habe eine Suchfunktion aus bestehenden Code umgebaut, ich möchte gerne von diser Funktion ein Range Objekt mit allen Treffern erhalten (wenn das überhaupt möglich ist ?)
Nun hänge ich schon den heutigen Tag dran und erkenne einfach den Fehler nicht, vielleicht kann mir dabei jemand behilflich sein ?
Area = Tabelle1.Range("A:M")
Token = Suchwort bzw. Suchwörter
MatchCase = Selbsterklärend

Public Function RangeSearch(ByRef Area, ByRef Token, ByVal MatchCase As Integer) As Range
Dim Match As Range
Dim Matches As Range
Dim firstMatch As String
If MatchCase  0 Then
Set Match = Area.Find(Token, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
Else
Token = "*" & Token & "*"
Set Match = Area.Find(Token, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
End If
If Not Match Is Nothing Then
firstMatch = Match.Address
Do
Set Matches = Union(Matches, Match)           ' firstMatch
End If
If Not Matches Is Nothing Then
RangeSearch = Matches
End If
End Function

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Find Range Union Problem
19.08.2014 14:30:13
Mullit
Hallo,
dazu benötigt die Funktion ein Array-Objekt als Rückgabewert:
Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" ( _
    ByRef pArray() As Any) As Long

Public Function RangeSearch(ByRef Area, ByRef Token, ByVal MatchCase As Integer) As Range()
          
    Dim Match As Range
    Dim Matches As Range
    Dim firstMatch As String
    Dim aobjMatches() As Range
    Dim ialngIndex As Long
    
    If MatchCase <> 0 Then
        Set Match = Area.Find(What:=Token, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
    Else
        Token = "*" & Token & "*"
        Set Match = Area.Find(What:=Token, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    End If
               
    If Not Match Is Nothing Then
        firstMatch = Match.Address
        Do
            ialngIndex = ialngIndex + 1
            Redim Preserve aobjMatches(ialngIndex - 1) As Range
            Set aobjMatches(ialngIndex - 1) = Match
            Set Match = Area.FindNext(After:=Match)
        Loop While Not Match Is Nothing And Match.Address <> firstMatch
    End If
    
    Set Match = Nothing
    
    If CBool(SafeArrayGetDim(aobjMatches)) Then
      RangeSearch = aobjMatches
      For ialngIndex = 1 To Ubound(aobjMatches) + 1
         Set aobjMatches(ialngIndex - 1) = Nothing
      Next
    End If

End Function

Public Sub test() 'Bsp-Aufruf 1.Wert.... 
 MsgBox RangeSearch(Cells(1, 1).Resize(6, 1), "20", 0)(0).Row
End Sub


VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel



Code erstellt und getestet in Office 12

Gruß,

Anzeige
AW: Find Range Union Problem
19.08.2014 14:53:02
Mullit
Hallo,
der Aufruf benötigt noch eine Fehlerbehandlung:
Public Sub test() 'Bsp-Aufruf 1.Wert....
On Error Resume Next
MsgBox RangeSearch(Cells(1, 1).Resize(6, 1), "tt", 0)(0).Row
If Err Then _
MsgBox "Der Wert ist nicht vorhanden.", vbExclamation
End Sub

Gruß,

AW: Find Range Union Problem
19.08.2014 16:24:24
BinärCode
Vielen Dank

AW: Find Range Union Problem
19.08.2014 15:44:14
Luschi
Hallo BinärCode,
hier mal mein poraktisches Beispiel. Beachte, daß ich von Dir definierte Variablennamen, die Excel-Vba selber im eigenen Sprachgebrauch hat, umbenannt habe.
https://www.herber.de/bbs/user/92185.xlsm
Gruß von Luschi
aus klein-Paris

Anzeige
AW: Find Range Union Problem
19.08.2014 16:27:06
BinärCode
Super, vielen vielen Dank für die Hilfe und besonderen Dank für das Beispiel !
Wenn man zu lange vor einem Fehler sitzt und immer zwischen Dokumentation und Try&Error wechselt sieht man den Wald vor lauter Bäumen nicht mehr.
Nochmals vielen Dank
Grüße aus Bonn
BinärCode

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige