Értékek listázása hét száma alapján Excel Vba

Értékek listázása hét száma alapján Excel Vba
2018-12-08T03:14:32+01:00
2019-03-30T06:38:54+01:00
2022-10-15T21:40:21+02:00
Drakan
Sziasztok!

Egy olyan problémába kérném a segítséget ami pont az év végén bukott ki. Az i értéke az A1 cellába szereplő aktuális dátumnak megfelelő hét száma,ami váltható le és fel egyaránt,de ez nem is fontos. B-oszlopba vannak a hét számok 1-52 és minden héten van kb 300 sornyi adat. A gyorsabb futás érdekében az i értékét úgy állítottam,hogy aktuális hét-3 és aktuális hét +1. Az év vége felé haladva előreállítva az A1 cellába lévő dátumot vettem észre,hogy csak a 2.heti elmaradásokat listázza. Az egyik megoldás,hogy "i = 1 To 53" ezt tudom csak ez lassabb. Nekem valami olyasmi megoldás lenne jó,amit jelenleg is használok. pl.:51.hét 52.hét 01.hét 02.hét 03.hét amit listáztatni szeretnék vele,de 4-50.heteket ne figyelje. A lehetséges megoldásokat előre is köszönöm! het = wn(Range("A1").Value) For i = het - 3 To het + 1 Dolgozom.Label1 = "Szekrény-Összeállításra vár: " & String(54 - i, ".") Dolgozom.Repaint DoEvents NumGoodValues0 = Application.Evaluate("SUMPRODUCT(--(" & ThisWorkbook.Sheets(1).Name & "!B4:B" & Lastrow & "=" & i & "),--(" & ThisWorkbook.Sheets(1).Name & "!L4:L" & Lastrow & "=""""))")
Mutasd a teljes hozzászólást!
Dim actDate As Date Dim lastDate As Date Dim actWeek As Integer actDate = CDate(Range("A1")) - 4 * 7 lastDate = CDate(Range("A1")) + 21 Do While actDate <= lastDate actWeek = Wn(actDate) i = actWeek vege = Cells(Rows.Count, "B").End(xlUp).Row ter1 = "B4:B" & vege ter2 = "C4:C" & vege ter3 = "H4:H" & vege col1 = Application.Sum(Application.CountIfs(Range(ter1), i, Range(ter3), "")) col2 = Application.Sum(Application.CountIfs(Range(ter1), i, Range(ter3), "", Range(ter2), "H(55)")) + Application.Sum(Application.CountIfs(Range(ter1), i, Range(ter3), "", Range(ter2), "HF")) If col1 > 0 Then ListRow = ListRow + 1 ThisWorkbook.Sheets(1).ListBox1.AddItem Z & ".hét :" ThisWorkbook.Sheets(1).ListBox1.List(ListRow, 1) = col1 ThisWorkbook.Sheets(1).ListBox1.List(ListRow, 2) = col2 End If actDate = actDate + 7 Loop
Mutasd a teljes hozzászólást!

  • Én a Select Case metódussal indulnék neki. Leginkább azért, mert lehet rövidesen nemcsak erről a pár hétről kell riport, hanem még tetszőelegesen bármelyikről.

    Dim het as Byte het = Range("A1") Select Case het Case 1 'kód Case 2 'kód Case 51 'kód Case 52 'kód Case Else msgbox "az összes többi hét"
    Mutasd a teljes hozzászólást!
  • Szia!
    Köszönöm az ötletet de végül 
    Do While ciklus lett a megoldás.
    Később leírom,hogy hogyan.
    Mutasd a teljes hozzászólást!
  • Dim actDate As Date Dim lastDate As Date Dim actWeek As Integer actDate = CDate(Range("A1")) - 4 * 7 lastDate = CDate(Range("A1")) + 21 Do While actDate <= lastDate actWeek = Wn(actDate) i = actWeek vege = Cells(Rows.Count, "B").End(xlUp).Row ter1 = "B4:B" & vege ter2 = "C4:C" & vege ter3 = "H4:H" & vege col1 = Application.Sum(Application.CountIfs(Range(ter1), i, Range(ter3), "")) col2 = Application.Sum(Application.CountIfs(Range(ter1), i, Range(ter3), "", Range(ter2), "H(55)")) + Application.Sum(Application.CountIfs(Range(ter1), i, Range(ter3), "", Range(ter2), "HF")) If col1 > 0 Then ListRow = ListRow + 1 ThisWorkbook.Sheets(1).ListBox1.AddItem Z & ".hét :" ThisWorkbook.Sheets(1).ListBox1.List(ListRow, 1) = col1 ThisWorkbook.Sheets(1).ListBox1.List(ListRow, 2) = col2 End If actDate = actDate + 7 Loop
    Mutasd a teljes hozzászólást!
Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd