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

• #50963 föccer nagyúr Fferi50 #50962

  Új Válasz 2023-05-09 18:10:07 #50963

  Ú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

  

  föccer

  nagyúr

  válasz Fferi50 #50962 üzenetére

  Az egyik bemeneti fülről leszedem az üzemek listáját sorba.rendez(egyedi()) függvénnyel. Ezen a listán megy végig az első for ciklus. A manuálisan is használható számoltábla úgy van előkészítve, hogy egyetlen egy paraméter cellája van, amin adat érvényesítéssel lehet listából megadni az üzem megnevezéseket. A for ebbe a cellába pakolja be az üzemek azonosítóját. Segédtáblán számoltatom hogy mennyi sor lesz az eredményen, leddig kell pörgetni a for-t, hogy minden adat kimásolásra és bemásolásra kerüljön.

  A második for cikus a már kiválasztott üzem azonosítójához tartozó, leszűrt adatokat tartalmazza. Ez az előbb említett kalkulációs rész, ahol max 500 sorban, elemenként megy a kiértékelés. (ez még 2018 körül készült eljárás, de miáltal sem a bemeneti tömbök, sem a kimenet nem változik, hibátlanul működik). Szóval a 2. for az üzem szűrt elemein megy végig, soronként.

  A 3. for ciklussal a a 34 oszlop adatait nyomom át a céltömbbe.

  A céltömb a MINTA ÖSSZES munkafüzet. Ide rakom egymás alá az összes üzemre szerzett adatot. Erről a széltömbből. másolom ki egy másik, összesítő táblázatba az eredményt, ahol tövábbi feldolgozást csinálok.

  Dim Most As Date
Dim Akt_sor As Integer
Dim Akt_oszlop As Integer
Dim Akt_minta_szama As Integer
Dim Uzemek_szama As Integer
Dim Mintak_szama As Integer
Dim Osszes_minta As Integer
Dim Akt_Uzem As String
Dim Akt_Uzem_sorszam As Integer

Most = Now
Application.StatusBar = "Üzemi mintavételek összesítésének állapota: Előkészítés..."

Akt_sor = 0
Akt_oszlop = 0
Akt_minta_szama = 0
Mintak_szama = 0
Uzemek_szama = Sheets("Mintavetelek_segedszamitas").Range("G1").Value
Osszes_minta = Sheets("Mintavetelek_segedszamitas").Range("G4").Value
Akt_Uzem = ""
Akt_Uzem_sorszam = 0

Sheets("MINTA_OSSZES").Range("A1:AH10000").ClearContents


For Akt_Uzem_sorszam = 2 To (Uzemek_szama + 1)

Sheets("Minta").Range("D1").Value = Sheets("Mintavetelek_segedszamitas").Cells(Akt_Uzem_sorszam, 1).Value
Sheets("Minta").Range("A5").Calculate
Sheets("Minta_NY").Range("A5:AH500").Calculate
Sheets("Mintavetelek_segedszamitas").Range("G2:G3").Calculate
Mintak_szama = Sheets("Mintavetelek_segedszamitas").Range("G3").Value

For Akt_sor = 5 To (Mintak_szama + 4)
For Akt_oszlop = 1 To 34
Sheets("MINTA_OSSZES").Cells(Sheets("Mintavetelek_segedszamitas").Range("G2").Value + 1, Akt_oszlop).Value = Sheets("Minta_NY").Cells(Akt_sor, Akt_oszlop).Value
Application.StatusBar = "Üzemi mintavételek összesítésének állapota: Üzemek: " & Akt_Uzem_sorszam - 2 & "/" & Uzemek_szama & " Minták: " & Akt_sor - 5 & "/" & Mintak_szama & " Összes minta: " & Akt_minta_szama & "/" & Osszes_minta & " Oszlopok: " & Akt_oszlop - 1 & "/34 van kész."
Next
Akt_minta_szama = Akt_minta_szama + 1
Next
Next

Application.StatusBar = ""
MsgBox "Kész vagyok. Köszönöm, hogy ma is dolgozhattam helyetted. Végrehajtási idő: " & Format(Now - Most, "hh:mm:ss;@")
End Sub

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