Hirdetés
-
GAMEPOD.hu
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
-
Delila_1
veterán
válasz jaszy83 #13345 üzenetére
Gyorsabb futást eredményez az újabb makró, és csak a két lap nevét kell módosítani, meg esetleg az 5000 sort.
Sub Rendez()
Dim sor As Long, usor As Long, oszlop As Integer
Dim WS As Worksheet, WSF As Worksheet
Application.ScreenUpdating = False
Set WS = Sheets("Munka3") '***************
Set WSF = Sheets("Felvitel") '***************
usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
WS.Select
oszlop = Range("XFD1").End(xlToLeft).Column
'Előző cella-egyesítések megszüntetése
Columns(1).MergeCells = False
'Előző adatok törlése
Rows("2:5000").Delete '***************
'Adatok a Felvitel lapról a Munka3-ra
WSF.Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy WS.Range("A2")
WS.Select
'Rendezés
Range(Cells(1, 1), Cells(usor, oszlop)).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:C" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Cellaegyesítés az A oszlopban
For sor = usor To 2 Step -1
If Cells(sor, 1) = Cells(sor - 1, 1) Then
Cells(sor - 1, 1) = ""
Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
End If
Next
'Keret
Range(Cells(1, 1), Cells(usor, oszlop)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlThin
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeBottom).Weight = xlThin
Selection.Borders(xlEdgeRight).Weight = xlThin
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Application.ScreenUpdating = False
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Penty
tag
Mivel errefelé rendkívül segítőkész emberkék kószálnak, ezért ismét bátorkodnék zavarni...
Adva van az alábbi képen látható két oszlop: Az A oszlopban pénzösszegek vannak (bevételek és kiadások), a B oszlopban pedig dátumok.
Ahogy az látható a képen, a negatív és a pozitív számokat (kiadásokat és bevételeket) sikerült szétválasztanom és megszámolnom külön-külön az E1 és E2 cellákban. Sikerült külön-külön szétválasztanom és megszámolnom a januári, februári és márciusi pénzeket is az E3-E5-ig terjedő cellákban, de van velük egy kis bibi: Szeretnem ezeket a hónapokra lebontott számokat is külön-külön negatív és pozitív számokra tovább bontani, hogy meg tudjam külön számolni a januári, februári, márciusi kiadásokat és bevételeket is.
A Libre Office-ben nem találtam SZUMHATÖBB függvényt, így valami más megoldás kellene. Nem baj, ha az Excel képlet kicsit eltér a Calc-os képlettől: a különbségeket ki tudom majd bogarászni.
Segítségeteket előre is köszönöm! -
Delila_1
veterán
Vegyél fel két oszlopot, amik külön választják a bevételt és a kiadást.
Bevétel -> =HA(B2>0;B2;"")
Kiadás -> =HA(B2<0;B2;"")Ezekből már készíthetsz kimutatást. Az Excelben lehet a dátumoknak tagolást adni, ami például hónapok szerint mutatja az összegeket.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Oly
őstag
válasz Fire/SOUL/CD #13349 üzenetére
Szia
Ez jó lett.
KösziSonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy - Galaxy S Advance - Galaxy S4 - Lumia 820 - Honor 7 - iPhone 5S
-
Oly
őstag
Sziasztok
Van egy hosszabb makróm, amiből kivettem most egy pár sort:
s = s + 1
Cells(s + 1, 11).Value = DateValue(Now)
Cells(s + 1, 12).Value = Cells(m + 1, 1).Value
Cells(s + 1, 13).Value = "A"
Cells(s + 1, 14).Value = 48
s = s + 1
Cells(s + 1, 11).Value = DateValue(Now)
Cells(s + 1, 12).Value = Cells(m + 1, 1).Value
Cells(s + 1, 13).Value = "A"
Cells(s + 1, 14).Value = 49
s = s + 1
Cells(s + 1, 11).Value = DateValue(Now)
Cells(s + 1, 12).Value = Cells(m + 1, 1).Value
Cells(s + 1, 13).Value = "A"
Cells(s + 1, 14).Value = 31
Cells(s + 1, 15).Value = "ID"
s = s + 1
Cells(s + 1, 11).Value = DateValue(Now)
Cells(s + 1, 12).Value = Cells(m + 1, 1).Value
Cells(s + 1, 13).Value = "A"A félkövérrel kiemelt rész ismétlődik elég sokszor.
Van arra lehetőség, hogy ez csak egyszer szerepeljen a kódban, amit mindig meghívok a megfelelő helyen?SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy - Galaxy S Advance - Galaxy S4 - Lumia 820 - Honor 7 - iPhone 5S
-
jaszy83
csendes tag
válasz Delila_1 #13350 üzenetére
Delila Köszi, az elsőt használom működik,
a gondom viszont elképesztően banális problémával szenvedek már egy napja.
a felvitel lapomon ahhoz hogy automatikusan kiszámolja a sulykategóriát ez a függvényt használom:
=HA(Rögzítés!A18=(0); "";FKERES(Rögzítés!B18;$G$2:$H$12;2))az általad írt függvényt már egy tiszta lapról használnám ahol csak és kizárólag a három szükséges adat lesz rajta, a súlykategória, a név és a súly. Ehhez a felvitel lapról másolom az értékeket a Munka2 lapra
Sheets("Felvitel").Select
Columns("B:B").Select
Selection.Copy
Sheets("Munka2").Select
Columns("C:C").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=FalseÍgy viszont a fenti HA függvény eredményeként másolja a semmit is, és az összesítésnél lesz néhány ami jó adat, ahol tartalmaz versenyző adatokat, viszont lesz nagyon sok olyan, ami üres adat, de ezt is keretezi és összevonja a semmit.
Valami olyasmi kellene ami csak akkor másol ha nem 0 vagy nem " " vagy nem tudom. Elakadtam.. -
félisten
A Cells(s + 1, 13).Value = "A" sor is ismétlődik. Direkt hagytad ki?
Amúgy megoldható SUB-al, csak az s változót publikusként kell deklarálni
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
Én így oldanám meg ezt a feladatot
Public s As Integer, m As Integer
Sub MySubRoutine(MyIndex_s As Integer, MyIndex_m As Integer, Optional MyValue As Variant, Optional MyString As Variant)
Cells(MyIndex_s + 1, 11).Value = DateValue(Now)
Cells(MyIndex_s + 1, 12).Value = Cells(MyIndex_m + 1, 1).Value
Cells(MyIndex_s + 1, 13).Value = "A"
If Not IsMissing(MyValue) Then Cells(MyIndex_s + 1, 14).Value = MyValue
If Not IsMissing(MyString) Then Cells(MyIndex_s + 1, 15).Value = MyString
End Sub
Sub MyMainCode()
s = s + 1
MySubRoutine s, m, 48
s = s + 1
MySubRoutine s, m, 49
s = s + 1
MySubRoutine s, m, 31, "ID"
s = s + 1
MySubRoutine s, m
End Sub[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Oly
őstag
válasz Fire/SOUL/CD #13358 üzenetére
Végül nem mókoltam, mert csak 8 helyen szerepel ugyanaz a 4 sor.
Nem sok.Most olyan bajom van, hogy "Could not find the specified object" üzit dob nekem erre a sorra:
If Form1.Controls("man_" & m).Value = False Thena Form1-en van 30 db ToggleButton, amiknek a neve man_1, man_2, stb...
Az m egy for ciklus változója.Egyébként helyesen lefut a makró, de a végén ezt az üzit bevágja.
Mi lehet baja?SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy - Galaxy S Advance - Galaxy S4 - Lumia 820 - Honor 7 - iPhone 5S
-
félisten
Dupla idézőjelről feledkeztél meg Írd be próbaképp direktbe hogy pl
If Form1.Controls("man_1").Value = False ThenÍgy elfogadja a man_1-et
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
félisten
Ááá, bocsi, hülyeséget írtam...
Szóval az lehet a gond, hogy az m ciklusváltozód olyan értéket vesz fel (man_m), amilyen nevű objektum nincs a userform-on. Valószínűleg a for ciklusod 1-el (vagy többel) tovább szalad, mint kellene. (Ahogy írtad 1-től 30-ig kellene futni a ciklusnak)[ Szerkesztve ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
-
Oly
őstag
válasz Fire/SOUL/CD #13361 üzenetére
Valóban túlcsordultam 1 sorral.
NEm mindig 30 tétel van a listában, ezért egy darab.teli által adott szám a ciklus vég, de csak 30-ig vannak a vezérlők.
Megoldom... Köszi.
SonyEricsson T20 - T68 - T610 - K700 - W800 - K750 - K800 - C702 - P1 - MOTO Defy - Galaxy S Advance - Galaxy S4 - Lumia 820 - Honor 7 - iPhone 5S
-
Alg
veterán
Sziasztok!
Tud valaki megoldást az office 2007 vs "régi" XLS "Fájlhiba, az adatok elveszhetnek!" problémára? Most épp egy 50 megás fájlban sikerült neki random kitörölni egyetlen mezőt és ezzel gallyra vágni az egészet és még csak nem is képlet volt benne, egyszerű érték.
"I love not man the less, but Nature more" // Giant TCR Adv. '16 Di2 // Fenix 7 SS // FiiO BTR3 + Truthear ZERO
-
jaszy83
csendes tag
válasz jaszy83 #13356 üzenetére
problem solved,
büszke vagyok magamra, sikerült fkeres makróval abszolválni hogy negyedik adatnak vigye fel a súlykategóriát:Sheets("Rögzítés").Cells(hova, 4) = Application.VLookup(suly, Range("Felvitel!$G$2:$H$12"), 2)
Viszont újabb segítségre lenne szükségem:
Az adatok lapon felvitt harmadik, kulcsadat a kezdősúly.
Az itt megadott adatot kellene úgy felhasználni, hogy pl. ha kezdősúlynak 700-at írok be, akkor 600-ig a versenylapon adott versenyző sorába egy minuszt rakjon 600ig (valami olyasmire gondolok hogy a 700 lenne a megadott parameter, amire szükségünk van, az az hogy hány oszlopba írjon adott sorban (tehát a versenyző sorában) E oszloptól kezdve. Mivel E oszloptól indulnak a súlyok 500 kilótól, ezért a képlet a "(parameter-500)/100" lehetne, ez így a példa 700 kilónál 2-t ad ki, és innen valami do-until jellegű dologgal (vagy egyéb lehetséges módon) E oszloptól adott sorban írna minuszt.
Na ezt így remélem sikerült érthetően leírni kicsit fáradt vagyok.. ;
előre is köszi a segítséget! -
Delila_1
veterán
válasz jaszy83 #13364 üzenetére
Azt majd megmondod, mi az X és H az egyes sorokban.
Sub Rendez_1()
Dim sor As Long, usor As Long, oszlop As Integer, uoszlop As Integer
Dim WS As Worksheet, WSF As Worksheet
Application.ScreenUpdating = False
Set WS = Sheets("Munka3") '***************
Set WSF = Sheets("Felvitel") '***************
usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
WS.Select
uoszlop = Range("XFD1").End(xlToLeft).Column
'Előző cella-egyesítések megszüntetése
Columns(1).MergeCells = False
'Előző adatok törlése
Rows("2:5000").Delete '***************
'Adatok a Felvitel lapról a Munka3-ra
WSF.Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy WS.Range("A2")
WS.Select
'Rendezés
Range(Cells(1, 1), Cells(usor, uoszlop)).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:C" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Cellaegyesítés az A oszlopban, "–" beírása
For sor = usor To 2 Step -1
If Cells(sor, 1) = Cells(sor - 1, 1) Then
Cells(sor - 1, 1) = ""
Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
End If
For oszlop = 5 To uoszlop
If Cells(1, oszlop) < Cells(sor, 4) Then
Cells(sor, oszlop) = "–"
Else
Exit For
End If
Next
Next
'Keret
Range(Cells(1, 1), Cells(usor, uoszlop)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlThin
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeBottom).Weight = xlThin
Selection.Borders(xlEdgeRight).Weight = xlThin
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Application.ScreenUpdating = False
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Mythunderboy
csendes tag
Sziasztok!
Lenne egy talán idétlennek tűnő kérdésem Az aktuális dátumot a "MA()" függvénnyel elhelyeztem egy munkalapon.Van e lehetőség arra ha a dátum elér egy általam megadott adott napot akkor indítson egy lapvédelmet így használhatatlanná tegye? Mint egy demo verzió aminek lejár a licensze?Spacesynth 4 ever!
-
bajor14
csendes tag
Sziasztok!
van egy elég nagy adathalmazom melyben betűkódok alapján dátumhoz és órához (negyed órás bontásban) vannak az infók hozzárendelve. úgy néz ki, hogy betűkód, dátum, idő és utána még kb 15 cella különbözö értékek egy sorban. azt szeretném vhogy összehozni, hogy szedje ki minden egyes negyed órában, hogy adott betűkódhoz pl a H oszlopban milyen érték tartozik. annyiva viszont bonyolódik, hogy a betűkódok csoportokat alkotnak, így pl. 7:30-hoz nem csak a 13-as tartozik, hanem másik 5 is.
ha esetleg valaki tudna segíteni, azt megköszönném!
(elnézést, ha kuszán fogalmaztam ) -
lappy
őstag
válasz Mythunderboy #13366 üzenetére
Szia!
Makróval biztos megoldható, de ebben csak a nagy tudásúak tudnak majd segíteni!Bámulatos hol tart már a tudomány!
-
Delila_1
veterán
válasz Mythunderboy #13366 üzenetére
A VB szerkesztőben a ThisWorkbook-hoz rendeld.
Private Sub Workbook_Open()
If Date > "2012.04.02" Then
Exit Sub
Else
'***** Ide jön, amit vérge akarsz hajtatni, ha nem járt le a dátum
End If
End SubÉrdemes a makrót levédeni a szerkesztőben a Tools | VBAProject- Properties | Protection fülön, ahol jelszóval tudod letiltani a megnyitását.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
bajor14
csendes tag
-
Mythunderboy
csendes tag
válasz Delila_1 #13370 üzenetére
Köszi Delila!
Lenne két kérdésem:
Egy két makrót már megírtam a segítségeddel de még nem nagyon vágok pár dolgot.
1, A " This Workbook"-hoz hogyan rendelem? (Ez az adott munkalap lenne amin alkalmaznám?)
2,Amit végre akarok hajtani ha nem jár le a dátum, tehát hibátlanul működik, az 5 munkalapon van és egymáshoz kapcsolódnak ezt hogyan kellene megírnom a makróban?Vagyis 5 munkalapot kellene "lezárni" egyszerre ,hogy se beleírni se adatokat megadni ne tudjanak.....
Vagy valamit nem jól csinálok? A makrólevédés az menni fog.Spacesynth 4 ever!
-
Delila_1
veterán
válasz Mythunderboy #13372 üzenetére
Azt hittem, mást is csinál a makró a lapvédelmen kívül.
A VB szerkesztőben bal oldalon a ThisWorkbook-ra duplán kattintasz, mire jobb oldalon kapsz egy üres lapot, oda másold be az alábbi kódot.
Ez minden lap minden celláját zárolja, és a hangzatos "mmm" jelszóval védetté teszi a lapokat. Adj helyette normálisat.
Mit értsek azon, hogy "adatokat megadni ne tudjanak"?
Private Sub Workbook_Open()
Dim lap%
If Date > "2012.04.01" Then
For lap% = 1 To 5
Sheets(lap).Select
Cells.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True, Password:="mmm"
Next
Else
Exit Sub
End If
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Alg
veterán
Na jó, kezd az agyamra menni az excel2007 az ő összes fájlformátumával
Adott egy eddig jól működő A.xls és egy eddig jól működő B.xlsm. Az utóbbiban egy függvény van megírva, és ezzel a függvénnyel hivatkozik az előbbire (egyfajta fkeres-szerűség ). ebben a felállásban eddig minden szép és jó volt.
1) Az A.xls elkezdett "Fájlhiba, az adatok elveszhetnek" hibákat dobni.
2) A.xlsm-ként mentve a B.xlsm-ben hivatkozás frissítésekor vagy "forrás nem található" vagy hibával elszáll az egész hóbelevanc.
3) A.xlsx-ként mentve mindig elszáll hibával hivatkozás frissítésnél.
4) B.xlsx-ként nem menthető, mert kinyírja a makrót.Egyéb lehetőség? Sem kedv, sem idő nem lenne az A fájlt újra nulláról megcsinálni egy üres .xlsx vagy .xlsm-ben (csak a miheztartás végett, ez egy .xls-ként 54, .xlsx-ként 15 megás fájl).
[ Szerkesztve ]
"I love not man the less, but Nature more" // Giant TCR Adv. '16 Di2 // Fenix 7 SS // FiiO BTR3 + Truthear ZERO
-
jaszy83
csendes tag
válasz Delila_1 #13365 üzenetére
Szia Delila, az X az a sikeres húzás, a H pedig hiba lenne... D oszlopban pedig majd számolja a hibákat
Viszont amit írtál az nekem hibát jelez:
Run-time error '1004':
Method 'Range' of object '_Global' failedés erre a sorra írja:
uoszlop = Range("XFD1").End(xlToLeft).Columnmi lehet a baja?
-
Delila_1
veterán
-
Mythunderboy
csendes tag
válasz Delila_1 #13373 üzenetére
Köszi Delila! Ismét
Az " adatokat megadni ne tudjanak" azt jelentené amit gyakorlatilag csinálni kéne a makrónak ,de ha jól értelmezem akkor pont ezt fogja csinálni tehát pont ilyenre gondoltam....letesztelni vajon hogyan tudnám? mert ha a mai dátumot adom meg hibaüzenetet ad de a holnapival már fut....vagy várjak holnapigSpacesynth 4 ever!
-
Delila_1
veterán
válasz Mythunderboy #13377 üzenetére
Szívesen.
A If Date > "2012.04.01" Then sorban állíthatod kedved szerint a dátumot.
Ha a mainál előbbit állítasz be, lefut a makró (akkor a lapok védettségét az "mmm" jelszóval fel tudod oldani, a cellák zárolását pedig az összes cella kijelölésével, és a formátumnál a "Zárolás" megszüntetésével).
Ha későbbit írsz ebbe a sorba, marad minden úgy, ahogy volt.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
-
Delila_1
veterán
válasz Mythunderboy #13379 üzenetére
Az End Sub fölé:
MsgBox "Ráfaragtál, Öcsi!"
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
atillaahun
veterán
Sziasztok, tartomány témában kérnék segítséget.
Outlook-ba importálnék be egy xls-ben lévő címlistát. De az Outlook azt mondja nem tudja importálni a fáj tartalmát, mert nincsenek tartományok meghatározva. Hozzam létre őket Excel-ben.
2003-mas változatot használok mindkét programból, Excel-ben megcsináltam, amit a SÚGÓ mond/mutat, de mikor a =OFSZET($A$2,0,0,DARAB2($A$2:$A$200),1) képletet bírom a felugró ablakba, és leokéznám, csak annyit mond: "A beírt képlet hibás.", és nem tudom mihez kezdjek vele.
Egyébként egyszerű a fájlom tartalma, A oszlopban nevek vannak, B oszlopban meg e-mail-ek.[ Szerkesztve ]
-
atillaahun
veterán
válasz atillaahun #13382 üzenetére
Na végül megoldottam .csv formátumban, úgy hogy minden adatot kitöröltem, kivéve az e-mail címeket, így már egy fokkal egyszerűbb volt, szóval tárgytalan.
Lenne itt viszont egy másik apróság.
Mappaszerkezetet hogyan tudok exportálni? A beérkező üzeneteken belül hoztam létre vagy 50-et, amit nagyon nem szeretnék minden gépen megcsinálni. Végülis a szűrőkhöz/szabályokhoz tartozó mappák ezek, ahova automatikusan kerülnek a bejövő üzenetek.[ Szerkesztve ]
-
jaszy83
csendes tag
válasz Delila_1 #13376 üzenetére
Delila köszi megint, működik, mostmár látom a végét.
Tehát most a helyzet:
Első sorban feltüntetve növekvő sorrendben a súlyok (pl: 500; 600; 700 stb)
alatta sorokban vannak a versenyzők, nyilvántartva a húzásaikat:
k a sikeres húzás, h a hiba, minusz a kihagyott súly
Tehát például adott versenyző sora így néz ki:- - - K - - K - - H - - K - - H
a feladat az lenne, hogy a legnagyobb elhúzott súlyt függvényként megjelenítsem, tehát lefordítva excelesre, adott sor LEGJOBBRÁBB elhelyezkedő "K" (sikeres húzás) oszlopából az első sor (elhúzott súly) adatát szerepeltesse. Próbálkoztam egy ilyesmivel de valamiért ez nem helyes adatot ad (a legkissebb elhúzott súlyt adja, tehát a legbalrábban lévő "k"-t):
=INDEX($E$1:BC1;1;MAX(HOL.VAN("k";E11:BC11;0)))
(a súlyozás E oszloptól indul, ahogy a rögzítés is, előtte adatok vannak)
mi lehet a baja? a max nem pont hogy a legnagyobbat kéne adja? (ráadásul kipróbálva a MAX helyett MIN-re is ugyanezt a legkisebbet adja) -
Delila_1
veterán
válasz jaszy83 #13384 üzenetére
Nem mondhatom, hogy teljesen értem, ritkán húzgálok többszáz kilós súlyokat.
Most azt gondolom, hogy amelyik súly szerepel a Felvitel lap D oszlopában a név mellett, ahhoz a súlyhoz kell K-t írni a Munka3 lapon.De honnan jön a H?
Makró:
Sub Rendez_2()
Dim sor As Long, usor As Long, oszlop As Integer, uoszlop As Integer
Dim WS As Worksheet, WSF As Worksheet
Application.ScreenUpdating = False
Set WS = Sheets("Munka3") '***************
Set WSF = Sheets("Felvitel") '***************
usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
WS.Select
uoszlop = Range("IV1").End(xlToLeft).Column
'Előző cella-egyesítések megszüntetése
Columns(1).MergeCells = False
'Előző adatok törlése
Rows("2:5000").Delete '***************
'Adatok a Felvitel lapról a Munka3-ra
WSF.Select
Range("A2:C" & usor).Copy WS.Range("A2")
WS.Select
'Rendezés
Range(Cells(1, 1), Cells(usor, uoszlop)).Select
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:C" & usor)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Cellaegyesítés az A oszlopban, "–" beírása
For sor = usor To 2 Step -1
If Cells(sor, 1) = Cells(sor - 1, 1) Then
Cells(sor - 1, 1) = ""
Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
End If
For oszlop = 5 To uoszlop
If Cells(1, oszlop) < WSF.Cells(sor, 4) Then
Cells(sor, oszlop) = "–"
Else
Cells(sor, oszlop) = "K"
Exit For
End If
Next
Next
'Keret
Range(Cells(1, 1), Cells(usor, uoszlop)).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlThin
Selection.Borders(xlEdgeTop).Weight = xlThin
Selection.Borders(xlEdgeBottom).Weight = xlThin
Selection.Borders(xlEdgeRight).Weight = xlThin
Selection.Borders(xlInsideVertical).Weight = xlThin
Selection.Borders(xlInsideHorizontal).Weight = xlThin
Application.ScreenUpdating = False
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
jaszy83
csendes tag
válasz Delila_1 #13385 üzenetére
Delila, bocsánat úgy látszik túl fáradt voltam hogy sikerüljön világosan fogalmaznom
A képlet az már jó volt úgy köszi neked, a menet a következő:
1. felvittük az adatokat, önsúlyból automatikusan kiszámolja melyik súlykategória,
majd a második makró sorbarendezi őket ahogy kell és átrakja verseny lapra.2. Innentől manuális a kezelése, a belépősúllyal kezd a versenyző, ha elhúzza akkor a sorába beírok egy K-t, ha hibézik akkor H-t. Így megy tovább, sikeres húzás esetén mehet tovább, ha következő választott súlyt kihagyja akkor megint K-t írok a sorába stb, egész addig, amíg az utolsó sikeres húzásra írok be neki K-t , többet már nem bír elhúzni. Legyen ez mondjuk 4000 kiló az egyik versenyzőnél. A sorok végére akartam írni egy olyan függvényt, ami a legnagyobb elhúzott súlyt írja ki adott versenyzőnél, tehát hogy az első sor (ahol a súlyok vannak növekvő sorrendben) azon adatát írja be a függvény mezőbe abból az oszlopból, amelyik a legtöbb elhúzott súly a versenyző sorában, tehát amelyik legjobbra helyezkedik el.
(nálam VERSENY lapon első sor E oszloptól kezdődik 500 kilótól a súly, és tart 100 kilónként BC oszlopig, 5500ig, innen kell kinyerni az adatot abból az oszlopból, ahol a versenyző sorában a verseny végén az utolsó K (sikeresen elhúzott súly) van).
na azt hiszem jól leírtam, remélem így érted mit szerenék.Na erre írtam én a
=INDEX($E$1:BC1;1;MAX(HOL.VAN("k";E11:BC11;0)))
függvényt, ami nem akar működni...
előre is köszi a segítséged! -
Delila_1
veterán
válasz jaszy83 #13388 üzenetére
Az előző makróból hagyd ki a Cells(sor, oszlop) = "K" sort, mivel manuálisan írod be.
Az uoszlop = Range("IV1").End(xlToLeft).Column sorban az egyenlőség jobb oldala helyett beírhatod fixen az 55 értéket (BD oszlop száma).A kézi bevitel után indíthatod a másik makrót, ami a BD oszlopba beírja a legnagyobb elhúzott súlyt.
Sub LegnSuly()
Dim sor%, usor As Integer, oszlop%
Sheets("Verseny").Select
usor = Range("B2").End(xlDown).Row
For sor% = 2 To usor
For oszlop% = 55 To 5 Step -1
If Cells(sor, oszlop%) = "K" Then
Cells(sor, "BD") = Cells(1, oszlop%)
Exit For
End If
Next
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
plaschil
aktív tag
Sziasztok!
Segítséget szeretnék kérni egy makró megírásához. Adott egy lista. Ez tartalmaz több karakterkódot (ez most mindegy mi, pl. "ABC", "CAB", "CBA" hasonlók...), és ezekhez tartozik egy másik kód (ez most mindegy mi, pl "1234", "9876", "1243" hasonlók... de nem integer, mert pont is van benne, csak az egyszerűség kedvéért adtam meg így).
Így lesz egy olyan listám ami pl. így néz ki:
ABC 1234 5
ABC 1234 6
ABC 4321 2
ABC 4321 2
CBA 1234 1
CBA 1234 5
stb...
Na most az azonos "ABC"-k azonos kódjai mellett van egy szám (aláhúztam) ezeket szeretném összeadni.
Vagyis ABC 1234 esetén azt adja vissza nekem hogy:
ABC 1234 11
ABC 4321 esetén azt hogy:
ABC 4321 4
És így tovább, mint egy pivot, csak aztán nekem még mahinálnom kell az adatokkal és 100x egyszerűbb lenne ha egy makró adná ezt vissza nekem.Hú, érthető ez így? :S
Creative G500 vezérlő panelt keresek// Hol vagy helyileg? - A kisszobába. // Szilvásbuktát, mert azt szeretem!
-
Delila_1
veterán
válasz plaschil #13390 üzenetére
Nem adtad meg, hogy az Excelnek melyik verzióját alkalmazod.
Ha 2007-et, vagy 2010-et, akkor a Szumhatöbb függvényt használd, ha alacsonyabb verziód van, akkor fel kell venned egy segédoszlopot.
A D1 cella legyen: =A1&" "&B1, ezt másold le az adataid mellé.
Az összegző oszlop 1. cellájába ezt írd: =SZUMHA(D:D;A1&" "&B1;C:C), és másold le.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
plaschil
aktív tag
válasz Delila_1 #13391 üzenetére
Ha jól látom miután készen van, csak a duplikációkat kell kiszednem és ugyanazt kapom mint egy pivotból.
Nagyon szépen köszönöm, eddig nem ismertem ezt a függvényt, nem régóta dolgozom excel-ben, de lehet ezt a függvényt tudom alkalmazni egy másik problémámnál.
Mégegyszer köszönöm!
Ja és ha már itt vagyok, a sok segítségért cserébe:Hogy el ne hervadj!
Creative G500 vezérlő panelt keresek// Hol vagy helyileg? - A kisszobába. // Szilvásbuktát, mert azt szeretem!
-
Delila_1
veterán
válasz plaschil #13392 üzenetére
Köszönöm!
Régebben már írtad az általad alkalmazott Excel verzióját, de nem jegyeztem meg. Láttam valakinél, hogy az adatainál az Aláírás rovatba írta be, jó ötletnek tartom.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
veterán
válasz bajor14 #13394 üzenetére
Hozz létre egy kimutatást az adataidból!
A Sorcímkékhez tedd be az A és a C oszlop címét, a Jelentésszűrőbe a B-ét, az Értékekhez a H-ét.
A sok összegző sor zavaró lehet. Ezek egyikén jobb klikk, Mezőbeállítások, a Részösszegek közül a Nincs választót jelöld be.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Mythunderboy
csendes tag
Sziasztok!
Delila szeretném "továbbfejleszteni" a dátumos makrót .Olyan formában ha lehetséges ,hogy a lap legelső megnyitásakor rögzítené az aznapi dátumot és innentől számítva egy szövegdobozban mindíg megjelenítené hány napig használható még a program.Amikor letelik akkor zárná le véglegesen a lapvédelemmel....Azt hogy hány napig használható azt külön meg lehetne határozni. Ilyen szerinted megoldható lenne?[ Szerkesztve ]
Spacesynth 4 ever!
-
Delila_1
veterán
válasz Mythunderboy #13396 üzenetére
A zaro változóban add meg a lejárat dátumát.
Private Sub Workbook_Open()
Dim lap%, zaro As Date
zaro = "2012.04.15"
If Date >= zaro Then
For lap% = 1 To 5
Sheets(lap%).Select
Cells.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True, Password:="mmm"
Next
MsgBox "Megmondtam!"
Else
MsgBox zaro - Date & " nap van még hátra!"
Exit Sub
End If
End Sub...és hogy ne kelljen a próbálgatásoknál egyenként feloldanod a lapvédelmeket, és a cellák zárolását:
Sub Felold()
Dim lap%
For lap% = 1 To 5
Sheets(lap%).Select
ActiveSheet.Unprotect Password:="mmm"
Cells.Locked = False
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Mythunderboy
csendes tag
válasz Delila_1 #13397 üzenetére
Köszönöm a gyors választ! Lehet nem jól fogalmaztam ,de igazándiból úgy gondoltam,hogy nem a dátumot adnám meg ameddig érvényes,hanem azt az időt ahány napig tudja használni.(Ez több emberhez is elkerülne és valaki korábban valaki később nyitja meg először .Az első megnyitáshoz hozzáadná annyi napot ahány napra be van állítva , és addig lenne használható)
Így is megoldható? (A "felold" makro nagyon jó ötlet ,és igen hasznos lett)Spacesynth 4 ever!
-
Delila_1
veterán
válasz Mythunderboy #13398 üzenetére
Továbbra is a zaro változóba kell beírni, hány napig legyen érvényes a demo.
Mivel az első megnyitás dátumát csak úgy lehet megjegyezni, ha a füzet tartalmazza, az első lap IV1 cellájába írattam be, hozzáadva a zaro értéket, ez adja a lejárat napját. Ha ez a cella üres (első megnyitás), akkor bekerül oda a lejárat dátuma.
A további futtatásoknál megvizsgálja a makró, hogy az aktuális dátum >= IV1 értéknél. Ha igen, megy a védelem. Ha nem, jön a szöveg a hátralévő napok számával. Elég lenne az aktuális dátum = IV1 feltétel, de lehet, hogy aznap nem nyitják meg a fájlt.Private Sub Workbook_Open()
Dim lap%, zaro As Date
zaro = 5
If Sheets(1).Cells(1, 256) = "" Then
Sheets(1).Cells(1, 256) = Date + zaro
Exit Sub
End If
If Date >= Sheets(1).Cells(1, 256) Or Date - Sheets(1).Cells(1, 256) = 0 Then
For lap% = 1 To 5
Sheets(lap%).Select
Cells.Locked = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True, Password:="mmm"
Next
MsgBox "Megmondtam!"
Else
MsgBox (Date - Sheets(1).Cells(1, 256)) * -1 & " nap van még hátra!"
End If
Sheets(1).Select
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
Új hozzászólás Aktív témák
- Windows 10/11 Home/Pro , Office OEM/Retail kulcsok
- Game Pass Ultimate előfizetések 1 - 19 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- AMD Game Bundle: Warhammer 40,000: Space Marine 2 és Unknown 9: Awakening - LEGOLCSÓBB!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
Állásajánlatok
Cég: HC Pointer Kft.
Város: Pécs
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest