- MasterDeeJay: Gigabyte GA-B350M-D2 - AM4 lap 2016-ból amikor még nem volt Ryzen!
- sziku69: Fűzzük össze a szavakat :)
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- Magga: PLEX: multimédia az egész lakásban
- urandom0: Új kedvenc asztali környezetem, az LXQt
- eBay-es kütyük kis pénzért
- aquark: Jó platformer játékokat keresek!
- gban: Ingyen kellene, de tegnapra
- sh4d0w: Árnyékos sarok
-
LOGOUT
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
cousin333
addikt
válasz
m.zmrzlina #10891 üzenetére
Ez a sor:
kilistahossz = Application.WorksheetFunction.CountA(Range(Cells(1, 1), Cells(belistahossz, 1)))
véletlenül nem ez akart lenni?
kilistahossz = belistahossz - Application.WorksheetFunction.CountA(Range(Cells(1, 8), Cells(belistahossz, 8)))
Legalábbis a feladat alapján: azon sorokat másolja, ahol a H oszlopbeli cella nincs kitöltve.
-
cousin333
addikt
válasz
m.zmrzlina #10897 üzenetére
Értem én, hogy elvileg gyorsabb, azért is lepett meg, hogy nálam lassabban futott, mint az "alap" megoldás. Persze lehet, hogy csak az én implementációm volt rossz (most sajnos nem tudom beírni a kódot).
Nálam 3 x 20 ezer celláról van szó, a műveleteket 4 ezerszer hajtom végre ezen a bemeneti tartományon, tehát nem lehet panasz a terhelésre. Először tömbképlettel csináltam, kb. leölte a gépet...
-
m.zmrzlina
senior tag
válasz
cousin333 #10896 üzenetére
...hogy a bemenő változókkal egyesével feltöltök egy-egy tömböt, az eredményeket kiszámolom egy másik tömbbe, majd egyesével kiírogatom őket a megfelelő helyekre...
Amit nekem sikerült kiérteni a vonatkozó forrásokból az az, hogy a szóban forgó módszert pont azért érdemes használni mert nem visz el rengeted időt az egyenkénti olvasás-írás. Gyakorlatilag az Excel "fejben" számolja az eredményt és egyszerre írja vissza a munkalapra.
A futásidő különbség nálam egy másik tartománynál (kb 8000 cella és mindegyikben WorksheetFunction-os szövegmanipuláció): cellánkénti módszernél 70mp körül, a "fejbenszámolós" módszer 1mp alatt
...(akár a
Sheets("újhely").Range("A11:H11").Value = Range("A23:H23").Value
módszerrel) átmásolod az új helyre....
Gyakorlatilag ez a módszer volt amit először javasoltam, de ez több ezer cellánál már időigényesebb a "tömbös" mószernél.
-
cousin333
addikt
válasz
m.zmrzlina #10891 üzenetére
Amennyire én értek hozzá, jónak tűnik a megoldás. Nem mellesleg éppen ma szembesültem én is ezzel a módszerrel...
Viszont például az én problémámra (amivel jelenleg foglalkozom), úgy tűnik, gyorsabb a "sima" megoldás, nevezetesen, hogy a bemenő változókkal egyesével feltöltök egy-egy tömböt, az eredményeket kiszámolom egy másik tömbbe, majd egyesével kiírogatom őket a megfelelő helyekre. Nem biztos, hogy tuti módszerrel csinálom, mindenesetre a "sima" módszer futása kb. 6,3 mp, míg az egyszerre olvasósé 10,6 mp (persze számolni is kell, nem csak egyik helyről a másikra pakolászni). Szóval érdemes lehet több megoldást megvizsgálni és Timer funkcióval megmérni egy nagyobb adattömegen, hogy mi a gyorsabb (esetleg különböző adatmennyiségek esetén is nézni, hogy hogyan skálázódnak a különböző módszerek).
Mindenesetre már összeállt a fejemben egy másik megközelítés, ami reményeim szerint sokkal gyorsabb lesz majd. Ennél a problémánál is gyorsabb megoldásnak tűnik, ha végigmész a 8. oszlopon, és ha az adott sorban nincs értéke, akkor a komplett sort (akár a
Sheets("újhely").Range("A11:H11").Value = Range("A23:H23").Value
módszerrel) átmásolod az új helyre.
-
Delila_1
veterán
válasz
copperhead #10893 üzenetére
-
copperhead
aktív tag
Sziasztok! Azt, hogy kell beállítani, mint az itt látható első táblázatban, hogy az első 5 sor fixen marad, hiába görgetem az oldalt?
-
m.zmrzlina
senior tag
Szerettem volna Pale (#10873)-ban leírt problémáját mintegy a magam okulására egy másik megközelítésből megoldani.
Már többször használtam azt a módszert, hogy (főleg nagyobb tartományoknál) nem cellánként olvasok és írok hanem egyben egy egész tartományt olvasok be, elvégzem a műveletet és egyben írom vissza a munkalapra az eredményt. Innen vettem az ötletet
Eddig még sosem volt olyan helyzet, hogy az eredmény tartomány méretét ne tudtam volna előre, hanem menet közben kelljen meghatározni.A következő kódot sikerült kiagyalni, és nem tudom, hogy (noha úgy tűnik működik) valójában így kell-e csinálni ezt vagy van-e erre valami bevett profi megoldás. Minden építő kritikát szivesen veszek.
Sub atmasol()
Dim bemenoadat() As Variant, eredmeny() As Variant
Dim i As Long, j As Integer, belistahossz As Long, kilistahossz As Long, m As Long
belistahossz = Cells(Rows.Count, 1).End(xlUp).Row
bemenoadat = Range("A1:H" & belistahossz).Value
kilistahossz = Application.WorksheetFunction.CountA(Range(Cells(1, 1), Cells(belistahossz, 1)))
m = 1
ReDim Preserve eredmeny(1 To kilistahossz, 1 To 8)
For i = 1 To belistahossz
If bemenoadat(i, 8) <> "" Then
For j = 1 To 8
eredmeny(m, j) = bemenoadat(i, j)
Next j
m = m + 1
End If
Next i
Worksheets("Munka2").Range("A1:H" & kilistahossz).Value = eredmeny
End Sub -
-
Baboka
tag
válasz
Delila_1 #10884 üzenetére
Bővítményekkel sem jó sajna, berakom az egész makrót, nem egy nagy cucc hátha így tudsz segíteni:
Sub gomb()
Dim mo1, mo2, mo3, eo, ssz, osz, fk, i, j, k As Integer
mo1 = frmmasol.tbmo1.Text
mo2 = frmmasol.tbmo2.Text
mo3 = frmmasol.tbmo3.Text
eo = frmmasol.tbeo.Text
ssz = frmmasol.tbssz.Text
osz = frmmasol.tbosz.Text
fk = frmmasol.tbfk.Text
Sheets(1).Select
Range("A1").Select
If frmmasol.cbtabla.Value = False Then
Windows("1.xls").Activate
Sheets(1).Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Masolo.xls").Activate
Sheets(1).Select
Cells.Select
ActiveSheet.Paste
End If
Windows("2.xls").Activate
Sheets(1).Select
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows("Masolo.xls").Activate
Sheets(2).Select
Cells.Select
ActiveSheet.Paste
Sheets(1).Select
Range("A1").Select
For i = fk + 1 To ssz
If (Sheets(2).Cells(i, eo).Value <> "") Then
For j = fk + 1 To ssz
If (Sheets(1).Cells(j, mo1).Value = Sheets(2).Cells(i, mo1).Value) And (Sheets(1).Cells(j, mo2) = Sheets(2).Cells(i, mo2)) And (Sheets(1).Cells(j, mo3) = Sheets(2).Cells(i, mo3)) Then
For k = 1 To osz
Sheets(1).Cells(j, k) = Sheets(2).Cells(i, k)
Next k
End If
Next j
End If
Next i
End Sub -
Delila_1
veterán
válasz
Baboka #10883 üzenetére
Az EO-t tedd idézőjelek közé, ha ez az oszlop betűjele. Ha nem, akkor egész számnak kell lennie.
Az mo1-nek, mo2-nek, és mo3-nak is egész szám értéket kell képviselnie.Az említett hibajelenség még akkor szokott előfordulni, ha a Bővítménykezelőben nincs bekapcsolva az Analyzis ToolPak - VBA. A nem VBA-sat is kapcsold be, az a munkafüzetekhez ad egy halom új, jól használható függvényt.
-
Baboka
tag
sziasztok!
Elkezdtem egy táblaösszemásoló makrót megírni, még kezdő vagyok nagyon, ezt kérem figyelembe venni, de az a problémám hogy mindig a jó kis runtime error 1004 jön ki a program ciklusainál
For i = fk + 1 To ssz
If (Sheets(2).Cells(i, eo).Value <> "") Then <-------- itt halódik meg az egész
For j = fk + 1 To ssz
If (Sheets(1).Cells(j, mo1).Value = Sheets(2).Cells(i, mo1).Value) And (Sheets(1).Cells(j, mo2) = Sheets(2).Cells(i, mo2)) And (Sheets(1).Cells(j, mo3) = Sheets(2).Cells(i, mo3)) Then
For k = 1 To osz
Sheets(1).Cells(j, k) = Sheets(2).Cells(i, k)
Next k
End If
Next j
End If
Next ifk: táblafejléc kezdete
eo: ellenőrző oszlop, ha üres akkor meg sem kell vizsgálni
mo1,2,3: adatoszlopok száma, amiket meg kell vizsgálniaha tudtok segíteni akkor előre is köszönöm!
-
Pale
csendes tag
válasz
m.zmrzlina #10877 üzenetére
Köszönöm!
(Föccernek is!) -
beers
addikt
Sziasztok!
Hogy tudom azt megoldani, hogy nyomtatásban a legfeljső sor minden oldalon egyfajta fejlécként megjelenjen?
-
m.zmrzlina
senior tag
A létező legprimitívebb megoldás és ha valóban bolondbiztossá kell tenni akkor sok dolog lesz még vele de kiindulásnak talán jó:
Sub atmasol()
Dim sor As Integer
sor = 1
Worksheets("Munka1").Select
Do Until IsEmpty(Cells(sor, 1).Offset(1, 0)) = True
If Cells(sor, 8) <> "" Then
Range(Cells(sor, 1), Cells(sor, 8)).Copy Worksheets("Munka2").Range("A" & Worksheets("Munka2").Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
sor = sor + 1
Loop
End SubMunka1-en vannak a kiinduló adatok és Munka2-re teszi az eredményt, illetve azt feltételeztem, hogy az A oszlopban a lista aljáig egyetlen cella sem üres. Valamint a H oszlop üres celláiban <szóköz> sem lehet.
-
föccer
nagyúr
Ha egyszer be van kapcsolva a szűrő, akkor csak annyi a feladat, hogy legördít, rákattint, hogy "üres", majd nyomtat. A nyomtatási képen is csak a leszűrt elemek jelennek meg. (én ezt sok ezer soros táblázattal így csinálom, egyszerre 8-10 feltételt használva, és hibátlan) Ez sem bonyolultabb, mint megnyomni egy gombot, munkalapot váltani, és úgy nyomtatni. Mind a kettőt meg kell mutatni és el kell magyarázni legalább egyszer. Ráadásul, ha a tisztelt felhasználó elkefél valamit, akkor a szűrős verziót akár telefonon keresztül, távvezérelve is vissza tudod állítani, mert csak a menüben kell kattintgatni. Ez esetben szerintem az egyszerűbb jobb megoldást adna.
üdv, föccer
-
Pale
csendes tag
Tiszteletem!
Van egy excel táblázatom. Mondjuk a1:h30-ban vannak adatok.
Egy olyan makró kellene nekem amely ennek a táblázatbak azokat a sorait másolja át egy másik munkalapra, melynek a h oszlopbeli cellája nincs kitöltve.
Köszönöm előre is, ha valaki foglalkozik az üggyel! -
bugizozi
őstag
válasz
nvyktor #10844 üzenetére
Szia,
ilyen probléma nálunk is volt. jelenség ugyanez, plusz néztem, hogy amig homokórázik az Excel, addig a Celeron proci 15-20%-ra, a 100Mbit-es hálózat 2-4%-ra volt leterhelve.
Oka: az egyik windows update feltette a Microsoft Office File Validation Add-in-t ami a hálózatról megnyitott Exceleket mindig leellenőrizte, ami egy több megás, több 1000 soros Excelnél nem 2 perc volt..
Megoldás menete: Programok telepítése és törlése -> delete -> örül
Remélem ez nálad is megoldja ezt a problémát
-
Delila_1
veterán
válasz
csela1 #10865 üzenetére
Nem kell ehhez makró. A B1 (vagy másik oszlop első cellája) képlete:
=HA(SZÁM(A1);1;"szöveg")
a második sor képlete: =HA(SZÁM(A2);MAX(B$1:B1)+1;"szöveg")Ez utóbbi végig másolható.
Ha a szöveget akarod látni a képleteket tartalmazó oszlopban, akkor a "szöveg" helyett legyen A1, ill. a második sorban A2.
-
csela1
csendes tag
Szép napot kívánok!
Azzal a problémával fordulok a nálamnál jobban az Excel programozásához értőkhöz, hogy:
Van egy táblázatom, Az „A” oszlopban egymás alatt szöveg és szám található vegyesen. Sorszámozni szeretném úgy, hogy vizsgálja meg, hogy a fölötte lévő cella szám-e, ha igen, akkor adjon az abban a cellában található szám értékéhez egyet és az a szám legyen a kiindulási cellába írva, ha nem, akkor nézze meg, hogy az az fölötti cella szám-e. Mindaddig vizsgálja a fölötte lévő cellákat, amíg nem talál egy olyat, amiben szám van, és ahhoz adjon egyet
1
szöveg
szöveg
szöveg
2
szöveg
szöveg
szöveg
3tehát ha a 2-es cellán állok vizsgálja meg, hogy fölötte lévőben szám van-e, mivel szöveg van, vizsgálja meg az az fölötti cellát, majd az az fölötti cellát, ahol végre talál egy számot (1) ehhez adjon hozzá egyet és írja az aktuális cellába (2).
Köszönöm szépen a megtisztelő segítséget előre is.
üdvözlettel:
csela -
ArchElf
addikt
válasz
Lompos48 #10861 üzenetére
Fejlécen jobb gomb > Control toolbox > Spin button
Kiteszed az objektumot, jobb gomb rajta > Properties
Linked Cell mezőbe beírod a cella címét (pl. D3) amit változtatni szeretnél.
Végül kikapcsolod a design módot a control toolbox első ikonjára kattintva (ami eddig be volt keretezve).AE
-
m.zmrzlina
senior tag
válasz
dellfanboy #10855 üzenetére
Nekem az A1:B4000-ben vannak a változópárok amiket el kell osztani egymással, az eredmény pedig az F1:F50 tartományba illetve attól jobbra kerül.
Sub lepopulal()
Dim bemenoadat As Variant
Dim eredmeny As Variant
Dim i As Integer
bemenoadat = Range("A1:B4000").Value
eredmeny = Range("F1:EXA1").Value
For i = 1 To 4000
eredmeny(1, i) = bemenoadat(i, 1) / bemenoadat(i, 2)
Next i
Range("F1:EXA50") = eredmeny
End Sub -
m.zmrzlina
senior tag
válasz
dellfanboy #10855 üzenetére
Hol kell keresni a változókat és hová kell tenni az eredményt?
-
föccer
nagyúr
válasz
dellfanboy #10855 üzenetére
Függvénnyel sem bonyolult.
=$A$1/$B$1
Ez megy az összes cellába. Lehúzható, másolható. Folyamatosan az A1/B1 cellára fog mutatni a hivatkozás.
üdv, föccer
-
Delila_1
veterán
válasz
dellfanboy #10855 üzenetére
Sub mm()
Range("A1") = 100: Range("B1") = 50: Range("C1") = Range("A1") / Range("B1")
Range("C1").Copy
Range("F1:F50").Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub -
dellfanboy
őstag
hogy oldanátok meg az alábbi problémát excelben makrók segítségével? a1cella= 100, b1cella=50, c1cella= a1/b1 jelen esetben 2.
Ezt az értéket szeretném értékkel bemásolni a f1 cellaba majd f50ig lepopulálni.Tehát f1től f50ig minden cellában 2-es érték szerepeljen.
Tudom ez nem nehéz de a1,b1 nálam változó és van belőle, több ezer. -
Delila_1
veterán
válasz
Lompos48 #10851 üzenetére
Alapjában véve egyetlen sor a makró
Növelésre:
Sub Nov()
Selection = Selection + 10
End SubCsökkentésre:
Sub Csokk()
Selection = Selection - 10
End SubLehet aztán cifrázni, pl. ne az éppen aktuális cella értékét módosítsa, hanem kérje be a cella címét, és a változtatás mértékét.
-
Lompos48
nagyúr
Van-e valakinek birtokában olyan makró, amellyel egy cella tartalmát ismételten ("gombnyomásra") növelni/csökkenteni lehet egy megadott számmal (inkrementummal)? Vagy bármilyen konstruktív ötlete?
-
nvyktor
aktív tag
válasz
Fire/SOUL/CD #10849 üzenetére
Köszönöm, holnap kipróbálom.
Írok majd, hogy megoldotta-e?Addig is jó éjt, már nagyon mennék haza...
-
válasz
nvyktor #10848 üzenetére
Az IE alapértelmezett beállításait állítsd vissza: [link]
Az IE-ről az köztudott, hogy böngésző, ez nem újdonság ezer éve, az viszont átlag user kategóriában nem ismert(és nem is kell hogy tudja egy home useri), hogy az IE a Windows szerves részét képezi, bizonyos összetevőit sok alkalmazás használja, pl az Office.
(Pl tipikus jelenség, hogy messengerben nincsenek meg a reklámok, ennek pusztán az az oka, hogy nem az IE az alapértelmezett böngésző... Szóval olyan helyre is kihatással lehet, amire nem igazán gondolnak)Az, hogy az megoldja-e a dolgot, nem állítom biztosra, de egy próbát megér.
Amúgy megpróbálhatod, hogy a megosztott adatbázis címét, beírod az IE címsorába, ha az is nagyon lassan fogja letölteni, akkor szinte biztos, hogy ez a gond -
nvyktor
aktív tag
válasz
Fire/SOUL/CD #10847 üzenetére
Szia!
Igen, írtam, hogy minden uptodate.
Egyik napról a másikra, nem volt telepítés.Switch van a hálózaton, de minden gép azt használja. Adott esetben megér egy próbát, de logisztikailag macerás. 3 emelet választja el a swithet a géptől...
IE melyik részét tegyen alapbeállításra? Ez hogyan szólhat bele?
Köszi a választ előre is!
-
válasz
nvyktor #10846 üzenetére
# Office SP3 fent van, uptodate az Excel?
# Egyik napról a másikra jött ez a dolog, nem telepítettél bármit, ami a hálózatot érinti?
# Ha van router, akkor próba erejéig szedd ki a hálózatból (bár ha jól veszem ki a mondandódból, akkor ez a gép, a többi géppel közös hálózatban van)
# Internet Explorer-t alapbeállításokra visszaállítani. -
nvyktor
aktív tag
válasz
ArchElf #10845 üzenetére
Szia!
Linket tartalmaz is, meg nem is. Képletekkel ugyanez, van olyan ami tele van számolással, de olyan is, amiben csak szöveg van.
A fájl megnyitási művelet a lassú, ~50-100 másodperc.
MS megoldásokat (érdemieket már néztem), a reinstall (főleg az OS) nem opció sajnos a user habitusa és természete miatt.
Restart többször is volt (kb 4 napja jeleztés a problémát).
És elfelejtettem írni, hogy természetesen minden up-to-date, WSUS-on keresztül.
-
ArchElf
addikt
válasz
nvyktor #10844 üzenetére
Linkeket tartalmaznak azok a fájlok (más fájlokra esetleg)?
Mit jelent az, hogy lassú, lassan nyílik meg, lannam lehet menteni, lassan frissíti az adatokat (vagy egyéb)?Esetleg microsoft megoldások:
- roaming profile esetén új profile
- excel start átböngészése
- restart
- office reinstall
- os reinstallAE
-
nvyktor
aktív tag
Sziasztok!
Ehhez hasonló problémám van.
Hálózati meghajtóról nyitja meg lassan a fájlokat 2 db XP SP3 + Office 2003-as gép.
Több helyen olvastam utána a dolognak, így íme a triviális kérdésekre a válaszok:
- csak a hálózati megnyitás lassú, lokális gépről nem,
- nem csak az explorerből nyílik lassan, hanem a file menü / megnyitás parancs alól is,
- a többi gépnek (még ugyanilyen konfiggal se) nincs baja a hálózati fájlok megnyitásával, vagyis a hálózat, a szerver, a fájlok valószínűleg rendben vannak,
- csak excel fájlokkal van gond.Kipróbáltam már több féle javítást, de egyik sem hozott eredményt:
- DDE tiltás,
- "Más alkalmazásokat mellőz" opció,
- vírusírtó / tűzfal kikapcs,
- /firstrun
- registry macerálás is volt, hogy úgy érezze először indul...Van esetleg valami ötletetek?
Köszi előre is!
V. -
zenus
csendes tag
válasz
Fire/SOUL/CD #10841 üzenetére
Pontosan erre volt szükségem, köszönöm szépen! Hálám kergessen el ...
zenus -
Nem biztos, hogy jól értem a gondod, szóval az lenne a lényeg, hogy a SZUM függvényben változnia kell a paramétereknek, a B és C oszlopban szereplő értékek alapján?
Ha igen, akkor 2 képlet, remélem az egyik (vagy mindkettő) megfelel...
F1 cellába -> =SZUM(INDIREKT("H1:H"&B1))
F2 cellába -> =SZUM(INDIREKT("H"&C2+1):INDIREKT("H"&B2)) -
zenus
csendes tag
Sziasztok!
Egy kérdés, amit nem makróval szeretnék megoldani.
A képen látható egy ParamSzum nevű oszlop. A paraméterek állandóan változnak, nem tudni, mikor mekkora értéktartományt kell összeadni, mert a Van oszlop értékei mindig változnak. A H oszlopból viszont csak azokat az értékeket kell venni, amelyek a Van érték + 1 től az Elvárt oszlopig tartanak. Az F oszlopban az aktuális képletet írtam be, de ezeket kellene ugye paraméterezni, hogy ne kelljen manuálisan írogatni azokat.
Az E2 cella tehát a SZUM(H1:H20) függvényt tartalmazza, mert az elvárt 20 és a meglévő 0 azt jelenti, hogy a teljes tartományt össze kell adni.
Az E3 cella pedig a SZUM(H8:H18) függvényt, mert itt egy bizonyos értéktartomány kizárásra kerül.
Nincs olyan verzió az adatoknál, hogy két tartományt kell összeadni, mindig csak egy középen valahol elhelyezkedő tartomány van.
A kérdés pedig: van-e ötlet a megoldásra ? Persze, ha nincs más, akkor marad a makró, arra is várok tippeket.
Köszönöm!
-
válasz
Delila_1 #10838 üzenetére
De, igazam van (és ezt tudod, csak szeretsz gonoszkodni, akárcsak én)
"Más volt a cél, ő a címsort színezi, ha aktív a szűrő, Te üzenetet küldesz."
Hát nem kell hozzá atomfizikusnak lenni, hogy function-t varázsoljon belőle valaki, ami igaz/hamis értéket ad vissza...(És legalább nem csak az Autofilter A1 cellájáról ad vissza helyesen infót, bár szerintem a korábbi verzió sem ad rossz infót...)Én is had kérdezzek valamit... olyannal már találkozott valaki, hogy az Excel időzítője valamiért áll?
Ilyennel még nem találkoztam (eddig)
-
Delila_1
veterán
válasz
Fire/SOUL/CD #10837 üzenetére
A csúf leírás m.zmrzlina kérdésére volt a válasz, nem tetszett neki a dupla With abban a makróban, amit letöltött valahonnan.
Szerintem nincs igazad az F1-gyes mondatoddal.
Más volt a cél, ő a címsort színezi, ha aktív a szűrő, Te üzenetet küldesz. -
válasz
Delila_1 #10836 üzenetére
Hát csak egy kissé nehezen követhető, talán így egyszerűbb
With Worksheets("Munka1")
If .AutoFilterMode Then
With .AutoFilter.Filters(1)
If .On Then
MsgBox ("Szűrve: " & """" & .Criteria1 & """" & " feltétel alapján.")
Else
MsgBox ("Nem szűrt")
End If
End With
End If
End WithA Filters tulajdonság indexével lehet hivatkozni, tartománya 1-től AutoFilter.Filters.Count-ig.
UI: "Aki ezt a rövid makrót írta, nagyon erényes. Szép.letisztult makrót írt."
Igen, nyomhatott volna egy F1-et inkább... [link] -
Delila_1
veterán
Folytatva az előbb elkezdettet, az eredeti makró
Function FilterOn(myCell As Range) As Boolean
On Error Resume Next
With myCell.Parent.AutoFilter
With .Filters(myCell.Column - .Range.Column + 1)
If .On Then FilterOn = True
End With
End With
End FunctionAz első With kezdősorában szerepel a myCell.Parent.AutoFilter, vagyis a megadott cella szülőjének (a munkalapnak) az autofiltere.
A With és End With közötti ponttal kezdődő hivatkozásokat úgy kell értelni, mint a kezdősorában lévő adat folytatása.A második With első sora [.Filters(myCell.Column - .Range.Column + 1)] a fenti autofilterre vonatkozik, az If-es sor pedig erre a filterre.
Mindent kiírva ez a belső sor így nézne ki:If myCell.Parent.AutoFilter.Filters(myCell.Column - myCell.Parent.AutoFilter.Range.Column + 1).On Then FilterOn = True
és akkor a teljes makró ennyi lenne:
Function FilterOn(myCell As Range) As Boolean
Application.Volatile
On Error Resume Next
If myCell.Parent.AutoFilter.Filters(myCell.Column - myCell.Parent.AutoFilter.Range.Column + 1).On Then FilterOn = True
End FunctionEzzel csak az a baj, hogy nehezen követhető.
-
Delila_1
veterán
válasz
m.zmrzlina #10830 üzenetére
A programozók fő erénye a lustaság. Ha nem muszáj, nem írnak le semmit kétszer.
Aki ezt a rövid makrót írta, nagyon erényes. Szép.letisztult makrót írt.Az első With kezdősorában szerepel a myCell.Parent.AutoFilter, vagyis a megadott cella szülőjének (a munkalapnak) az autofiltere.
A With és End With közötti ponttal kezdődő hivatkozásokat úgy kell értelni, mint a kezdősorban lévő adat folytatása.Szerk.: Ezt összezavartam, újra leírom.
-
m.zmrzlina
senior tag
válasz
Fire/SOUL/CD #10833 üzenetére
Ilyet olvastam a Súgóban:
A nonvolatile function is recalculated only when the input variables change
Nem lehet hogy az autofilter-rel ellátott tartománynak a fejléce nem számít bemenő változónak?
Mert ha ezt a kérdéses fv-t amivel kapcsolatban ittérdeklődtem =FilterOn(A1) helyett =FilterOn(A2)-ként akarom használni akkor Volatile nélkül is működik.
És ez megmagyarázza, hogy miért működik csont nélkül a feltételes formázásnál
???
-
válasz
m.zmrzlina #10831 üzenetére
Sehogy, nem is ahhoz írtam. Nem mellesleg meg a Volatile az oroszrulett, vagy megy, vagy nem, Nálam nem.
Az AutoFilter-t mint eseményt nem lehet elkapni ilyen egyszerűen, hiába a Change meg a Calculate esemény, egyikre sem fog reagálni. A Volatile csak kiadja a parancsot, mintha nyomnál egy F9-et...Szóval Nálam ez nem jó megoldás, meg még számos helyen. Igaz, nem szép megoldás, ez tény, de az enyém legalább minden excelen/gépen működik...
-
Delila_1
veterán
válasz
m.zmrzlina #10831 üzenetére
Igen, a Volatile a megoldás.
-
m.zmrzlina
senior tag
válasz
Fire/SOUL/CD #10829 üzenetére
Jó de ebből hogyan derül ki, hogy melyik oszlop adatai alapján van szűrve a tartomány?
Az eredeti kérdésben ti. ez volt. -
m.zmrzlina
senior tag
válasz
Delila_1 #10828 üzenetére
Ha kiegészítem ezzel a sorral:
Application.Volatile
akkor úgy tűnik működik.
Innen szedtem.Valójában egyetlen sorát sem értem ennek a függvénynek (na jó az elsőt és az utolsót igen
.), de ilyen egymásba ágyazott With..End With szerkezetet nem láttam soha
-
válasz
Delila_1 #10828 üzenetére
Tegyél a munkalapra pl. egy MOST() fx-et és az Worksheet Calculate eseményébe tedd a kódot. Ez meg egy másik megközelítés, a Filterhez
Private Sub Worksheet_Calculate()
'Szűrt terület sorainak teljes száma, a címsort is beleértve
MsgBox (AutoFilter.Range.Rows.Count)
'Szűrt terület aktuális (szűrt) sorainak száma, címsort is beleértve
MsgBox (AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count)
End SubÉrtelem szerűen, ha az a két érték egyenlő, akkor nincs szűrés, más esetben meg igen.
-
Delila_1
veterán
válasz
m.zmrzlina #10827 üzenetére
Igazad van, próba nélkül írtam be.
Olvastam valahol arról, mivel lehet rávenni a saját függvényeket a frissülésre, de most nem találom.
-
m.zmrzlina
senior tag
válasz
Delila_1 #10825 üzenetére
Maga a fv által visszaadott érték nálam valamiért így sem frissül. K1-be tettem ezt: =FilterOn(A1) és ha nincs szűrő az a oszlopban akkor HAMIS-t ad vissza. Azt várnám ha bekapcsolok egy szűrőt A1-ben akkor IGAZ-ra vált K1 értéke. Ez nem történik meg (az üres makróval sem) viszont ha bekapcsolt szűrőnél viszem be A1-re a FilterOn()-t akkor helyesen TRUE-t ad vissza.
Viszont ennek ellenére a felt. formázás jól működik
-
m.zmrzlina
senior tag
válasz
m.zmrzlina #10824 üzenetére
Ez működik!
Ezt a fv-t másold modulba:
Function FilterOn(myCell As Range) As Boolean
On Error Resume Next
With myCell.Parent.AutoFilter
With .Filters(myCell.Column - .Range.Column + 1)
If .On Then FilterOn = True
End With
End With
End Functionmajd formázd feltételesen a következőképpen:
A formázás érvényessége a példa munkalapon =$A:$G
-
Delila_1
veterán
válasz
m.zmrzlina #10824 üzenetére
Ez nagyon jó.
Azonnal frissül, ha a laphoz ezt az üres makrót hozzárendeled:
Private Sub Worksheet_Change(ByVal Target As Range)
End Submert figyeli a lapon történt változásokat, és csak frissít.
-
Delila_1
veterán
válasz
Pityke78 #10813 üzenetére
Játszottam a szűrővel.
Hagyd üresen az első és második sort, és adj ezeknek a celláknak szöveg formátumot. A lenti makró (gombhoz rendelheted) ezekbe a sorokba kiírja a szűrés feltételeit zöld háttérrel.Sub Crit_1_2_sorba() '1:2 sorba írja a feltételeket zöld háttérrel
Dim AF As AutoFilter, F As Filter, sz$, oszlop%
Set AF = ActiveSheet.AutoFilter
For oszlop% = 1 To AF.Filters.Count
Range(Cells(1, oszlop%), Cells(2, oszlop%)) = ""
Range(Cells(1, oszlop%), Cells(2, oszlop%)).Interior.ColorIndex = -4142
Set F = AF.Filters(oszlop%)
If F.On Then
Cells(1, oszlop%) = F.Criteria1
Cells(1, oszlop%).Interior.ColorIndex = 4
If F.Operator > 0 Then
If F.Operator = xlAnd Then sz$ = "és " Else sz$ = "vagy "
Cells(2, oszlop%) = sz$ & F.Criteria2
Cells(2, oszlop%).Interior.ColorIndex = 4
End If
End If
Next
End Sub -
Delila_1
veterán
válasz
föccer #10821 üzenetére
A címsorba a feltétel ilyen lenne:
Sub Krit_A_Cimsorba()
Dim AF As AutoFilter, F As Filter, i As Long
Sheets("Munka1").Select
Set AF = ActiveSheet.AutoFilter
For i = 1 To AF.Filters.Count
Set F = AF.Filters(i)
If F.On Then
Cells(1, i).NumberFormat = "@"
Cells(1, i).Value = Right(F.Criteria1, Len(F.Criteria1) - 1)
End If
Next
End Sub -
föccer
nagyúr
válasz
Delila_1 #10818 üzenetére
Nekem ez jutott az eszembe:
Sub Filt()
Dim AF As AutoFilter, F As Filter, i As Long, usor As LongSet AF = ActiveSheet.AutoFilter
usor = Range("A65536").End(xlUp).RowFor i = 1 To AF.Filters.Count
Set F = AF.Filters(i)
If F.On Then
Cells(1, i) = Cells(usor, i)
End If
Next
End SubEzt még te készítetted nekem.
üdv, föccer
-
Delila_1
veterán
válasz
Pityke78 #10813 üzenetére
Tegyél ki ehhez a makróhoz egy gombot, a futtatás után a szűrt oszlopok fejléce (1. sor) piros hátterű lesz.
Sub AutoSzuro()
Dim AF As AutoFilter, F As Filter, oszlop As Long
Set AF = ActiveSheet.AutoFilter
For oszlop = 1 To AF.Filters.Count
Set F = AF.Filters(oszlop)
If F.On Then
Cells(1, oszlop).Interior.ColorIndex = 3
Else
Cells(1, oszlop).Interior.ColorIndex = -4142
End If
Next
End SubMajd jön ide valaki, aki megmondja, hogy lehet a szűrés változásához hozzárendelni, hogy ne kelljen külön gombot nyomogatni.
-
Pityke78
őstag
válasz
m.zmrzlina #10815 üzenetére
Ezt így vágom, de valjuk be őszntén, ez elég halovány vizualizáció.
Más lehetőség nincs? -
-
#94180096
törölt tag
válasz
Delila_1 #10812 üzenetére
Nem akartam az idődet rabolni..
Nem kértem még segítséget ilyen témában, gondolom ezért követtem el hibákat.
Legközelebb, megpróbálom pontosan megfogalmazni, amit akarok.
Bocsi, nem akartalak kihasználni vagy ilyenek, annak is örülök hogy eddig segítettél.
Innen akkor megoldom én.Üdv,
Ádám -
Pityke78
őstag
Lehet olyat csinálni a 2007-es excelben, hogy ha az oszlopokba be van helyezve a szűrő, akkor mondjuk más színnel, vagy egyéb, látható jelzéssel lehessen látni, hogy melyik oszlop van leszűrve?
Ha sok oszlop van, akkor olykor elég macerás visszakeresni, hogy mely oszlopok vannak leszűrve.
Vélemény?
-
Delila_1
veterán
válasz
#94180096 #10811 üzenetére
A 10782-ben hányadost kerestettél, amit megváltoztattál a 10789-ben. Az újabb válaszra most mindent átírsz.
Ha szívességet kérsz valakitől – igénybe véve az idejét és esetleges tudását –, vedd a fáradságot, hogy eleve azt kérdezed, amire szükséged van.
Nézd át jól a makrót, biztosan át tudod írni arra a feladatra, amit pillanatnyilag végre szeretnél hajtatni vele. Miért fordítanék több időt a válaszokra, mikor te, akinek szüksége van a válaszra, nem foglalkozol annyit a dologgal, hogy pontosan leírhatnád a kérdést?!
-
#94180096
törölt tag
-
-
djzomby
csendes tag
válasz
m.zmrzlina #10803 üzenetére
Nagyon profi a válasz!
Ez már nekem megfelelő. Évek óta agyalok rajta hogyan is kellene ezt megvalósítani, mert van olyan statisztikai táblám, hogy a SZUM függvénynek (több zárójelben) 175 db cellahivatkozás van felsorolva, mivel minden második oszlop értékeit kell csak beszámítani az összegbe.....
Színhasználattal ez egy csapásra megoldódik.Nagyon köszönöm!
Még valami:
ezt a personal.xls (personal.xlsb)-t hogyan is kell alkamazni?
Gondolom üres táblát nyitok, berakom új modulba a függvényt, és mentéskor a program filesbe teszem az office-on belül? de hová? (hogy minden új táblanyitáskor ismerje ezt az új függvényt a progi) -
m.zmrzlina
senior tag
válasz
djzomby #10788 üzenetére
Na tudtam, hogy egyszerűbben is lehet ezt.
Másold új modulba a következőt:
Function SZINESÖSSZEG(minta As Range, tartomany As Range)
Dim cella As Range, osszeg As Double
szin = minta.Font.Color
For Each cella In tartomany
If cella.Font.Color = szin Then
osszeg = osszeg + cella.Value
End If
Next cella
SZINESÖSSZEG = osszeg
End FunctionLegjobb ha a personal.xls (personal.xlsb) -be teszed mert akkor minden megnyitott munkafüzetben rendelkezésre fog állni egy SZINESÖSSZEG() nevű új függvény. Úgy használod mint a SZUM() fv-t csak ennek az első paramétere egy olyan abszolút cellahivatkozás (pl: $A$1) amiben ugyanolyan színű karakterek vannak mint amit össze akarsz adni.
Hogy érthetőbb legyen itt egy kép:
Köszönet az ötletért (ki másnak mint) Delila_1-nek
-
m.zmrzlina
senior tag
válasz
superecneB #10801 üzenetére
Válasz ment privátban.
-
superecneB
őstag
válasz
m.zmrzlina #10800 üzenetére
Köszönöm szépen! Sajna más szóra kerestem a keresővel, elnézést
Új hozzászólás Aktív témák
Hirdetés
- MasterDeeJay: Gigabyte GA-B350M-D2 - AM4 lap 2016-ból amikor még nem volt Ryzen!
- Apple asztali gépek
- iPhone topik
- Akciókamerák
- Lexus, Toyota topik
- Linux kezdőknek
- Kijelző került a kamerasávra a Xiaomi 17 Pro és 17 Pro Max hátulján
- iPhone-t használók OFF topikja
- Samsung Galaxy S24 FE - később
- Villanyszerelés
- További aktív témák...
- GYÖNYÖRŰ iPhone 14 Pro 128GB Gold -1 ÉV GARANCIA - Kártyafüggetlen, MS3544
- BESZÁMÍTÁS! AMD Ryzen 9 3900X 12 mag 24 szál processzor garanciával hibátlan működéssel
- GYÖNYÖRŰ iPhone 13 mini 128GB Red -1 ÉV GARANCIA - Kártyafüggetlen, MS3325
- BESZÁMÍTÁS! ASUS H610M i5 12400F 16GB DDR4 1TB SSD RTX 4060 8GB Rampage Shiva Cooler Master 650W
- ÁRGARANCIA!Épített KomPhone i5 13400F 16/32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft.
Város: Budapest