Microsoft Excel

Herbers Excel/VBA-Archiv

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

Find Range Union Problem

Betrifft: Find Range Union Problem von: BinärCode
Geschrieben am: 19.08.2014 13:35:56

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)           '<= Hier steigt vba aus ?
            Set Match = Area.FindNext(Match)            
        Loop While Not Match Is Nothing And Match.Address <> firstMatch
    End If
       
    If Not Matches Is Nothing Then
         RangeSearch = Matches
    End If

End Function

  

Betrifft: AW: Find Range Union Problem von: Mullit
Geschrieben am: 19.08.2014 14:30:13

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ß,


  

Betrifft: AW: Find Range Union Problem von: Mullit
Geschrieben am: 19.08.2014 14:53:02

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ß,


  

Betrifft: AW: Find Range Union Problem von: BinärCode
Geschrieben am: 19.08.2014 16:24:24

Vielen Dank


  

Betrifft: AW: Find Range Union Problem von: Luschi
Geschrieben am: 19.08.2014 15:44:14

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


  

Betrifft: AW: Find Range Union Problem von: BinärCode
Geschrieben am: 19.08.2014 16:27:06

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



 

Beiträge aus den Excel-Beispielen zum Thema "Find Range Union Problem"