motyl1
21.02.11,09:39
Prosim o pomoc, nakoľko si neviem dať rady.
Potreboval by som vyhľadať k hodnotám v stĺpci A všetky rovnaké hodnoty v stĺpci E, a do stĺpca B dopísať príslušné hodnoty z F.
VLOOKUP mi najde iba jednu (prvu) hodnotu z F a tu priradi.
V stlpci B by malo doplnit hodnoty BA, TT.
Ďakujem.
marjankaj
21.02.11,16:06
Prosim o pomoc, nakoľko si neviem dať rady.
Potreboval by som vyhľadať k hodnotám v stĺpci A všetky rovnaké hodnoty v stĺpci E, a do stĺpca B dopísať príslušné hodnoty z F.
VLOOKUP mi najde iba jednu (prvu) hodnotu z F a tu priradi.
V stlpci B by malo doplnit hodnoty BA, TT.
Ďakujem.

No skús toto
PaloPa
22.02.11,05:49
No skús toto
Ak ešte do funkcie doplní toto: Application.Volatile
pri zmene hodnoty sa automaticky prepočíta (ako klasický Excel vzorec)


Function prirad(co As String, stlpec As Range, cislo As Integer) As String
prirad = ""
Application.Volatile
If co <> "" Then
carka = ""
For Each bunka In stlpec
If bunka.Value = co Then
prirad = prirad + carka + bunka.Offset(0, cislo).Value
carka = ", "
End If
Next
End If

End Function

P.
motyl1
22.02.11,08:10
Dá sa tam ešte doplniť, aby do stĺpca B zapísalo tú istú hodnotu len raz?
marjankaj
22.02.11,09:57
Dá sa tam ešte doplniť, aby do stĺpca B zapísalo tú istú hodnotu len raz?

Dúfam, že tých hodnôt nebude priveľa. Maximum som dal na 100
motyl1
22.02.11,11:25
Dúfam, že tých hodnôt nebude priveľa. Maximum som dal na 100
Ďakujem :)
Hodnôt bolo okolo 2.900 ale podarilo sa mi to vytriediť.
PaloPa
22.02.11,14:11
Dúfam, že tých hodnôt nebude priveľa. Maximum som dal na 100


Možno "po funuse" :), ale ešte jedno riešenie výberu "uniq" hodnôt, cez funkcie SPLIT a JOIN (text na pole a naopak) a objekt Scripting.Dictionary


Function prirad(co As String, stlpec As Range, cislo As Integer) As String
Dim aPrirad, xPrirad As String

Application.Volatile

If co <> "" Then
carka = ""
For Each bunka In stlpec
If bunka.Value = co Then
xPrirad = xPrirad + carka + bunka.Offset(0, cislo).Value
carka = ", "
End If
Next

'pucuj duplikaty
aPrirad = Split(xPrirad, ", ")
aPrirad = RemoveArrayDupes(aPrirad)
xPrirad = Join(aPrirad, carka)

End If
prirad = xPrirad
End Function

Function RemoveArrayDupes(vArray As Variant)
Dim Dict As Object
Set Dict = CreateObject("Scripting.Dictionary")

For Each Item In vArray
If Not Dict.Exists(Item) Then Dict.Add Item, 1
Next Item

RemoveArrayDupes = Dict.Keys
End Function