Funkce (vzorec) pouze vraci funkcni hodnotu do bunky, ve ktere je zapsana.Pozadovanou transformaci dat z radku do pole lze vykonat procedurou VBA.
Nize uvedena procedura z listu 3 nacte hlavicky radku a sloupcu ciloveho pole a vlozi je na list 2. Postupne prochazi radky na listu 1 a podle hodnot ve sloupcich list1!Axx:Bxx prenasi hodnoty z list1!Cxx na list 2.
Je to pracovni verze, neni jeste osetren pripad, ze na listu 1 jsou v polich hodnoty neobsazene na listu 3, otestuj:
Kód: Vybrat vše
Option Explicit
Sub Transfer()
Dim SBlk As Range, SCll As Range
Dim TmpBlk As Range, TmpCll As Range, ABC() As Variant, XYZ() As Variant
Dim TWsht As Worksheet, TCll As Range, i As Integer
Dim TOffsR As Integer, TOffsC As Integer
' definovat bloky
With Worksheets("list1")
Set SBlk = .Range("a2:a" & .Cells(.Rows.Count, "a").End(xlUp).Row)
End With
Set TWsht = ActiveWorkbook.Worksheets("list2")
Set TCll = TWsht.Range("a1")
With Worksheets("list3")
' definovat bloky, nacist data, vlozit hlavicky radku a sloupcu na list2
Set TmpBlk = .Range("a2:a" & .Cells(.Rows.Count, "a").End(xlUp).Row)
ReDim ABC(TmpBlk.Rows.Count)
i = 1
For Each TmpCll In TmpBlk.Cells
ABC(i) = TmpCll.Value
TCll.Offset(i, 0).Value = ABC(i)
i = i + 1
Next TmpCll
Set TmpBlk = .Range("b2:b" & .Cells(.Rows.Count, "b").End(xlUp).Row)
ReDim XYZ(TmpBlk.Rows.Count)
i = 1
For Each TmpCll In TmpBlk.Cells
XYZ(i) = TmpCll.Value
TCll.Offset(0, i).Value = XYZ(i)
i = i + 1
Next TmpCll
End With
' prochazet radkova data na list1, presouvat do pole na list2
For Each SCll In SBlk.Cells
With SCll
' nalezt ofsety radku v polich ABC a sloupcu v polich XYZ
For TOffsR = LBound(ABC) + 1 To UBound(ABC)
If .Value = ABC(TOffsR) Then
Exit For
End If
Next TOffsR
For TOffsC = LBound(XYZ) + 1 To UBound(XYZ)
If .Offset(0, 1).Value = XYZ(TOffsC) Then
Exit For
End If
Next TOffsC
'prenest data
TCll.Offset(TOffsR, TOffsC).Value = .Offset(0, 2).Value
End With
Next SCll
Set SBlk = Nothing
Set SCll = Nothing
Set TmpBlk = Nothing
Set TmpCll = Nothing
Set TWsht = Nothing
Set TCll = Nothing
End Sub