< návrat zpět

MS Excel


Téma: Výpis hodnot dle měsíce rss

Zaslal/a 16.3.2023 16:39

Zdravím vás, ExcelMágové, mohu vás poprosit o radu? V příloze je jednoduchá vzorová tabulka. Potřeboval bych buď makrem nebo třeba maticovým vzorcem vypsat hodnoty z listu zdroj do listu hledání dle jednoho kritéria, a to měsíce zkoušek.
Dovedete mě nakopnout, prosím?
Děkuji moc, B

Příloha: zip54656_vypis-hodnot-dle-mesice.zip (13kB, staženo 13x)
Jméno
Kontrola
Text
  b i u s img code url hr   1 2 3 4 5 6 7 8 9 10

#054657
avatar
Třeba:

=FILTER(zdroj!A2:D13;(MĚSÍC(zdroj!E2:E13) = 3) * JE.ČISLO(zdroj!E2:E13))citovat
#054658
avatar
nebo takhle:
Option Explicit

Function TransposeArray(MyArray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long, Xlower As Long
Dim Yupper As Long, Ylower As Long
Dim tempArray As Variant
Xupper = UBound(MyArray, 2)
Xlower = LBound(MyArray, 2)
Yupper = UBound(MyArray, 1)
Ylower = LBound(MyArray, 1)
ReDim tempArray(Xlower To Xupper, Ylower To Yupper)
For X = Xlower To Xupper
For Y = Ylower To Yupper
tempArray(X, Y) = MyArray(Y, X)
Next Y
Next X
TransposeArray = tempArray
End Function

Sub Hledaj()
Dim shZ As Worksheet, shH As Worksheet
Dim arrZ As Variant, arrTmp() As Variant, arrResult As Variant
Dim lastR As Long, r As Long, iTmp As Long
Dim monthNR As String, strDate As String

monthNR = InputBox("Enter month in format 'MM':", "Enter month")

Set shZ = ThisWorkbook.Sheets("zdroj")
Set shH = ThisWorkbook.Sheets("hledání")
lastR = shH.Cells(Rows.Count, "A").End(xlUp).Row

If lastR > 2 Then
With shH
.Range("A3:D" & lastR).ClearContents
End With
End If

lastR = shZ.Cells(Rows.Count, "A").End(xlUp).Row
arrZ = shZ.Range("A2:E" & lastR)

For r = LBound(arrZ, 1) To UBound(arrZ, 1)
'convert date to string
strDate = CStr(arrZ(r, 5))
If Mid(strDate, 4, 2) = monthNR Then
iTmp = iTmp + 1
ReDim Preserve arrTmp(1 To 4, 1 To iTmp)
arrTmp(1, iTmp) = arrZ(r, 1)
arrTmp(2, iTmp) = arrZ(r, 2)
arrTmp(3, iTmp) = arrZ(r, 3)
arrTmp(4, iTmp) = arrZ(r, 4)
End If
Next r

arrResult = TransposeArray(arrTmp)

With shH
.Range("A3").Resize(UBound(arrResult, 1), UBound(arrResult, 2)) = arrResult
End With
End Sub
citovat
#054660
avatar
1) FILTER je super, akorát v práci mám starší Office a tam smolík :(
Nešlo by to nějak jinak vzorcem, prosím?
2) A makro mi nefunguje :( Asi u mě problém mezi klávesnicí a židlí.
Ale přesto děkuji moc, Bcitovat
#054662
avatar
A makro mi nefunguje
zadaj mesic ve formatu: 03 do inputboxcitovat
#054675
avatar
Nějak se s makry peru, nešlo by to, prosím, přece jenom maticí?
Dat je přece jenom hodně a já bych si to chtěl udělat za jednotlivé měsíce zvlášť na každém listu pro zpřehlednění.
Děkuji moc, B.citovat
#054676
avatar
Hravo Ti to vyrieši kontingenčná tabuľka. Nepotrebuješ ani makrá ani maticové vzorcecitovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09