Új hozzászólás Aktív témák

• #45334 Mutt senior tag m.zmrzlina #45324

  Új Válasz 2020-11-16 19:23:33 #45334

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz m.zmrzlina #45324 üzenetére

  Szia,

  Most olvasva végig a leírásodat, ugyanazt csinálod amit én is javaslok és napi szinten használok. Nincs jobb megoldás, kivétel ha Office Script-re térnél át mert ott simán lehet tömbök méretét növelni.

  2 megoldást tudok javasolni.

  1. A kiTömb csak 1-dimenziós legyen és a beTömb indexét tartalmazza. Amikor pedig íratsz ki, akkor a kiTömb-ből kapott index-el a beTömb-ből olvasod ki az értékeket.
  Memóriában nem fog sok helyet foglalni, lassitani sem igen fogja a feldolgozást, egyedül csak a kiírás lesz lassabb mivel nem tudod egy lépésben a tömb tartalmát kiírni. (Ez a megoldás nálam egy 3 percig futó makróból 2 percet vett el, szóval nem ideális ha sokat kell a lapon dolgozni. A 2-es opcióval gyors kiíratást elérsz, de oda kell figyelni a helyes indexek használatára!)

  2. Ne legyen probléma hogy a nem fixelt definiált tömbnek csak az utolsó méretét lehet változtatni. Képzeld el, hogy ez a tömb 90 fokkal el van forgatva az eredetihez képest. Az első sor innentől az első oszlopban lesz, a második sor a második oszlopban és így tovább. A kódod ilyenkor csak a hivatkozásban változik.

  Az alábbi minta kód a kék listából kiszűri az adatot, egy dinamikusan változó tömbbe.
  A sárga a dinamikus tömb eredeti (inverz) állapotát mutatja, de azt vissza lehet könnyedén konvertálni.
  

  Sub ReDIM_Minta()
Dim minta As Range
Dim beTomb()
Dim kiTomb()
Dim oszlopok As Long, sorok As Long, i As Long, j As Long

Set minta = ActiveSheet.Range("A1").CurrentRegion
oszlopok = minta.Columns.Count
sorok = minta.Rows.Count

'erre nincs szükség, de látható hogy sorok és oszlopok szerint van a beTömb
ReDim beTomb(1 To sorok, 1 To oszlopok)

'adatok betöltése a tömbbe
beTomb = minta

'kiTomb-öt állítsuk be hogy annyi "sora" legyen mint az erdeti oszlop szám
ReDim kiTomb(1 To oszlopok, 1 To 1)

'az első sor a beTomb-ben egy fejléc másoljuk be a kitömb-be
For i = 1 To oszlopok
'itt látszik hogy csak az index sorrendet kell felcserélni
kiTomb(i, 1) = beTomb(1, i)
Next i

'szűréssel a nőket tartalmazó rekordokat tegyük be a kiTömb-be
For i = 2 To sorok
'ha a beTomb 4. oszlopában N van akkor
If beTomb(i, 4) = "N" Then
'növeljük a kiTomb utolsó dimenzióját 1-el
ReDim Preserve kiTomb(1 To oszlopok, 1 To UBound(kiTomb, 2) + 1)

'bemásoljuk az adatokat a beTomb-ből
For j = 1 To oszlopok
kiTomb(j, UBound(kiTomb, 2)) = beTomb(i, j)
Next j
End If
Next i

'konvertálatlan dump - sárga
ActiveSheet.Range("F1").Resize(UBound(kiTomb, 1), UBound(kiTomb, 1)) = kiTomb

'konvertált dump - zöld
ActiveSheet.Range("F10").Resize(UBound(kiTomb, 2), UBound(kiTomb, 1)) = Application.Transpose(kiTomb)


End Sub

  üdv

Új hozzászólás Aktív témák