szánSájn, tibiCsoki, wörldPísz!
Nem mondom, hogy egyszerű volt, ami előtt ültem :):
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.
Aaron Blood, az ozgrid.com Excel coder site fórumán 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
Halálba idegesített már, hogy ott az offline help db-je a VBA motornak, ez meg minden egyes F1-re igyekszik az MSOffice online help site-ról tölteni. Természetesen körülnéztem az egész helpet, hogy hol lehet az offline helpet elsődleges prioritásúvá tenni, de sehol semmi. Végül kitúrtam, hogy hol lehet az egész online help hozzáférést tokkal-vonóval letiltani - itt van (nem volt egyértelmű rátalálni):
File/Options/Trust Center/Trust Center Settings.../Privacy Options/Connect to Office.com for updated content when I'm connected to the Internet.
Update: megkövetem a szidott codereket, természetesen helyes az eredmény. Ebből is látszik, hogy nem kellene éjjel fosni a kódot. Megyek, beáztatom a kenderkötelet.
Szerintük így korrekt:
?&H0100& and &H00FF&
0Sok minden hiányossággal számoltam már a VBA-val kapcsolatban, de arra még sose mertem gondolni, hogy egy binary and csak 8 bitig fog menni...
Okos, offsetelős color kezelést kell csinálnom Excelben (az Excel és az "okos" color kezelés két külön fogalom, de ettől most tekintsünk el).
Elsőnek csinálunk egy Long típusú color adatot épeszű RGB-re felbontó függvényt:
Sub color2RGB(myColor As Long, RGBComponents() As Byte) RGBComponents(0) = (myColor And &HFF0000) \ &H10000 RGBComponents(1) = (myColor And &HFF00&) \ &H100 RGBComponents(2) = (myColor And &HFF&) End Sub
A fenti függvény debilnek látszó részeihez némi magyarázat:
Ezek után írjunk egy color offsetelőt, ami egy Long colort tud offsetelni:
Function offsetColor(myColor As Long, Optional R As Integer = 0, Optional G As Integer = 0, Optional B As Integer = 0) As Long Dim RGBComponents(2) As Byte Call color2RGB(myColor, RGBComponents()) R = (R + RGBComponents(0)) Mod &HFF If R < 0 Then R = 0 G = (G + RGBComponents(0)) Mod &HFF If G < 0 Then G = 0 B = (B + RGBComponents(0)) Mod &HFF If B < 0 Then B = 0 offsetColor = RGB(R, G, B) End Function
Meg is volnánk, próbáljuk ki:
?Hex(offsetColor(myColor:=0, R:=1, G:=2, B:=3)) 30201
A bolygón minden más programozási nyelven azt várnád, hogy 0x010203 lesz az eredmény - ehelyett a "drágaszág" RGB() függvény az R és a B értékeit láthatóan megcserélve tárolja. Nice.
Biztosra akartam menni, hogy nem én vagyok az idióta és megnéztem az Excel VBA helpet - íme a gyári példa:
MyObject.Color = RGB(255, 0, 0) ' Set the Color property of MyObject to Red.
Értem én, hogy annak a Long-nak a struktúrája az engine belső magánügye, de könyörgöm, fiúk, ott Redmondban, mi a francért kell ezt másképp csinálni, mint az egész világ? Persze lehet, hogy az egész csak byte-sorrend kérdése, de már akar a franc belegondolni.
Már nem kell gondolkodnom, hogy mit javítsak meg a hétvégén:
Igen, az egy kerti lámpa, szerencsére csak 24 Voltos.
