Monthly Archives: May 2011

Törölköző nap, 2011 – ilyen volt

1 Reply

towel-day-2011-proof Tegnap Budapesten húztam az igát, egész nap a korporéten legelve, majd délután Duna Plaza és Mammut II. Előbbiben bő 10 törölközős bolondot számoltam, míg utóbbiban csak rám nézett hülyén mindenki. Külön extrapuszik járnak a mindig csodálatos hajú Anna kolléginámnak, aki miután értesült a Towel Day mibenlétéről, azonnal előkotort egy törölközőt, beállva így a kevés jótól boldog dilisek május 25-ére összeverődött csapatába. Ámen.]]>

VBA turbo: findRangeRecursive()

Leave a reply

postolta még 2004-ben az alábbi nagyszerű függvényt, melynek tech nyelven summázott dolga az, hogy egy tetszőleges forrásrange-ből filterezzen ki egy subRange-et a megadott matching pattern alapján: 

Function findRange(findItem As Variant, searchRange As Range, Optional lookIn As Variant, Optional lookAt As Variant, Optional matchCase As Boolean) As Range
    Dim C As Range, firstAddress As String
    If IsMissing(lookIn) Then lookIn = xlValues 'xlFormulas
    If IsMissing(lookAt) Then lookAt = xlWhole ' xlPart
    If IsMissing(matchCase) Then matchCase = False
    With searchRange
        Set C = .Find( _
        What:=findItem, _
        lookIn:=lookIn, _
        lookAt:=lookAt, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        matchCase:=matchCase, _
        SearchFormat:=False)
        If Not C Is Nothing Then
            Set findRange = C
            firstAddress = C.Address
            Do
                Set findRange = Union(findRange, C)
                Set C = .FindNext(C)
            Loop While Not C Is Nothing And C.Address <> firstAddress
        End If
    End With
End Function
Ehhez kellett ma némi extra. A feladat az volt, hogy n darab párhuzamos range-ben kell egymás után keresni és a végén megtalált target range-et visszaadni. Magyarra fordítva ez kb. úgy fest egy példával illusztrálva, hogy “keressük meg azokat a sorokat egy táblában, ahol az A oszlopban 12 van, a B oszlopban 300, a C oszlopban meg mondjuk ‘kisMukk'”. A megoldást a FindRangeRecursive() függvény szolgáltatja, mindenki fogyassza igénye szerint: 
Function findRangeRecursive(findItems As Variant, searchRanges As Variant, RC As Byte, Optional lookIn As Variant, Optional lookAt As Variant, Optional matchCase As Boolean) As Range
    Dim fii As Long, baseRange As Range, resultRange As Range
    Dim rOffset As Long, cOffset As Long
    If IsMissing(lookIn) Then lookIn = xlValues 'xlFormulas
    If IsMissing(lookAt) Then lookAt = xlWhole ' xlPart
    If IsMissing(matchCase) Then matchCase = False
    Set baseRange = searchRanges(LBound(searchRanges))
    For fii = LBound(findItems) To UBound(findItems)
        If fii < UBound(searchRanges) Then
            If RC = 1 Then rOffset = searchRanges(fii + 1).Row - baseRange.Row
            If RC = 2 Then cOffset = searchRanges(fii + 1).Column - baseRange.Column
        End If
        Set resultRange = findRange(findItem:=findItems(fii), searchRange:=baseRange, lookIn:=lookIn, lookAt:=lookAt, matchCase:=matchCase)
        If resultRange Is Nothing Then
            Set baseRange = Nothing
            Exit For
        Else
            Set baseRange = IIf(fii < UBound(searchRanges), resultRange.Offset(rOffset, cOffset), Nothing)
        End If
    Next fii
    Set findRangeRecursive = resultRange
End Function
]]>