-
Fototrend
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
m.zmrzlina
#12457
üzenetére
"ha már a Cells van használatban akkor a "B" helyett (második argumentum) én 2-t használnék"
Mostanában szoktam rá, hogy "B"-t használok inkább, mint oszlopszámot. 2-nél még könnyen követhető, de pl. 179-nél egy javításnál egyszerűbb követni a betűvel – FW – jelölt oszlop átírása.
-
Delila_1
veterán
válasz
jani-wan
#12453
üzenetére
Mikor sorokat töröltetsz, az oszlop aljától felfelé kell elindulni, másképpen kimaradnak a vizsgálatból bizonyos sorok.
Ez a makró a második sortól – címsort feltételezve – törli azokat a sorokat, ahol a B oszlopban kisebb dátum szerepel, mint az E1 cellában.
Sub DeleteRowbyDate()
Dim so As Long
For sor = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If Cells(sor, "B") < Range("E1") Then
Rows(sor).EntireRow.Delete
End If
Next
End SubAz ActiveSheet.UsedRange.Rows.Count a lapon létező utolsó sor számát adja.
Ha több sor van a lapon valamelyik oszlopban, mint a B-ben, a fenti helyett ezt írd: Range("B1").End(xlDown).Row -
Delila_1
veterán
válasz
poffsoft
#12449
üzenetére
Az előző lap kódnevét pl. így kaphatod meg:
lap = ActiveSheet.CodeName
lap = "Munka" & Right(lap, Len(lap) - 5) - 1
MsgBox lapNem szerencsés dolog aktív cellára hivatkozni makróban, mert ha véletlenül másik cellára kattintasz a makró indítása előtt, hamis eredményt kapsz.
Írd le pontosan, mit szeretnél elérni a makróval.
-
Delila_1
veterán
Az indító lapodhoz rendeld a kódot. A lapon bármit beírva a Q oszlopba a nevet és az email címet átmásolja a "Másolat" lap A és B oszlopába, az utolsó kitöltött sor alá.
Az első lapon a "bármi"-t törölve a Q oszlopból, törlődik a két adat sora a "Másolat" lapról.
Jól mutat, ha az első lap Q oszlopát Wingdings-re állítod, és jelölésnek ü karaktert viszel be, ami egy pipa jelet ad.Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 17 Then
Dim név$, email$, sor%, usor%, WS2 As Worksheet
Set WS2 = Sheets("Másolat")
név$ = Cells(Target.Row, 1).Value
email$ = Cells(Target.Row, 3).Value
usor% = WS2.Range("A" & Rows.Count).End(xlUp).Row + 1
If IsEmpty(Target) Then
For sor% = 2 To usor%
If WS2.Range("A" & sor%) = név$ And WS2.Range("C" & sor%) = email$ Then
WS2.Rows(sor%).Delete Shift:=xlUp
Exit Sub
End If
Next
Else
WS2.Cells(usor%, 1) = név$
WS2.Cells(usor%, 2) = email$
End If
End If
End SubA Set WS2 = Sheets("Másolat") sorban adhatod meg a saját lapod nevét a Másolat helyett.
-
Delila_1
veterán
válasz
poffsoft
#12441
üzenetére
Ha 10 alatt van a LAPok száma, ez is megoldás lehet:
ActiveCell.Select
x = "LAP" & Right(ActiveSheet.Name, 1) - 1
ActiveCell.FormulaR1C1 = "=" & x & "!RC[34]"
ActiveCell.Offset(1, 0).Range("A1").Selectde biztosan van egyszerűbb kivitel. Minden esetben az A2 cellára kell állni a futtatás után?
-
Delila_1
veterán
Paatrick és Palyika
Szívesen.
-
Delila_1
veterán
válasz
paatrick
#12432
üzenetére
Sub ved()
Dim lap%
For lap% = 1 To Sheets.Count
Sheets(lap%).Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="SzuperTitok"
ActiveSheet.EnableSelection = xlNoSelection
Next
End SubA Password-nél add meg a saját jelszavadat, vagy ha nem akarod jelszavazni, akkor el is hagyhatod. Ebben az esetben a Scenarios:=True utáni vesszőt is töröld ki.
Az ActiveSheet.EnableSelection = xlNoSelection sor letiltja a zárolt cellák kijelölését, ezt is elhagyhatod. -
Delila_1
veterán
-
Delila_1
veterán
válasz
macimeister
#12391
üzenetére
-
Delila_1
veterán
válasz
macimeister
#12391
üzenetére
Legegyszerűbben egy kimutatással dobhatod össze.
Most nincs időm kipróbálni, de azt hiszem, csak az oszlopokban lévő értékeket tudod így összeszámolni. Ha igen, akkor a sorokat alakítsd át oszlopokká irányított beillesztéssel, transzponálva. -
Delila_1
veterán
válasz
macimeister
#12391
üzenetére
Legegyszerűbben egy kimutatással dobhatod össze.
Most nincs időm kipróbálni, de azt hiszem, csak az oszlopokban lévő értékeket tudod így összeszámolni. Ha igen, akkor a sorokat alakítsd át oszlopokká irányított beillesztéssel, transzponálva. -
Delila_1
veterán
válasz
macimeister
#12389
üzenetére
=SZORZATÖSSZEG((A1:I1<>"")/DARABTELI(A1:I1;A1:I1))
Ez a képlet az A1:I1 tartományban előforduló különböző értékű cellák darabszámát adja eredményül.
Ugyanígy megadhatod a képletet az oszlopokra is, ha az A1:I1 helyett a megfelelő tartományt írod be. -
Delila_1
veterán
-
Delila_1
veterán
válasz
tezse66
#12375
üzenetére
Laphoz rendelve:
Option Explicit
Public lel, R%, G%, B%
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lel, betu As String, cim As String
Dim R%, G%, B%
If Target.Column = 1 Then
betu = Target: cim = Target.Address
If IsEmpty(Target) Then
Range(Target.Address).Interior.ColorIndex = -4142
Exit Sub
End If
szin betu, cim
End If
End SubModulba:
Sub szin(betu, cim)
Dim lel, R%, G%, B%
On Error Resume Next
lel = Sheets("Munka1").Range("A:A").Find(betu).Row
If IsEmpty(lel) Then Exit Sub
R% = Sheets("Munka1").Cells(lel, 2)
G% = Sheets("Munka1").Cells(lel, 3)
B% = Sheets("Munka1").Cells(lel, 4)
Range(cim).Interior.Color = RGB(R%, G%, B%)
End SubAz A oszlopba beírt értékeket figyeli. Üres cella leenterezése, vagy előző adat törlése kitöltetlen hátteret ad.
-
Delila_1
veterán
válasz
jani-wan
#12369
üzenetére
Sub elrejt()
Dim sor As Integer, oszlop As Integer
Sheets("Munka1").Select 'ezt írd át arra a lapnévre,
'ahol rejteni akarod a sorokat és oszlopokat
'Sorok rejtése
For sor = 2 To 20 '2-től 20. sorig ellenőriz, írd át a tartományt
If Cells(sor, 2) = "" Then
Rows(sor).Hidden = True
Else
Rows(sor).Hidden = False
End If
Next
'Oszlopok rejtése
For oszlop = 2 To 60 'B-től BH oszlopig ellenőriz, írd át a tartományt
If Cells(2, oszlop) = "" Then
Columns(oszlop).Hidden = True
Else
Columns(oszlop).Hidden = False
End If
Next
End SubHa a képletet tartalmazó cellák soronként nem a B oszlopban vannak, a Sorok rejtése részben az If Cells(sor, 2) = "" Then sorban a 2-t írd át az oszlop számára.
Kitehetsz egy gombot a lapodra az Űrlapok eszköztárból, majd a jobb klikkre előjövő menüben hozzárendeled az "elrejt" makrót. Utána már gombnyomásra elvégzi a műveletsort.
-
Delila_1
veterán
válasz
tezse66
#12362
üzenetére
Azt már írtam, hogy függvénnyel nem lehet megoldani. A cellába vagy függvényt írsz, vagy a példád szerinti B 00-04 P értéket. A függvények a beírásuk helyén működnek, nem adhatod meg, hogy pl. a SZUM függvény eredménye a szomszédos cellában jelenjen meg.
A bővítménykezelőben jelöld be a két Analysis kezdetű bővítményt, akkor jó lesz a makró. Ennek a helyéről sokszor volt már szó, keress rá az Analysis szóra.
-
Delila_1
veterán
-
Delila_1
veterán
válasz
cousin333
#12302
üzenetére
Tömb rendezése 1 oszlop szerint: állsz a rendezendő oszlopban bárhol – nem jelölöd ki az oszlopot –, és rákattintasz az ikonra, amelyik A-tól Z-ig, vagy amelyik Z-től A-ig rendez.
Ha kijelölöd a rendezendő oszlopot, akkor csakis azt rendezi, nem viszi magával a többi oszlop sorait.Sorrend megfordítása: az első üres oszlop első cellájába írsz egy egyest, a másodikba egy kettest. A kettőt együtt kijelölöd, és a kijelölés jobb alsó sarkában lévő kis fekete négyzetre adsz egy duplaklikket. Ettől egyesével növekvő számsort visz az eddigi tartományod mellé. Ezt az oszlopot rendezd csökkenő sorrendbe úgy, ahogy az első bekezdésben leírtam.
Rendezés szempontjából mi a különbség a tartomány és a tömb között?
-
Delila_1
veterán
válasz
tezse66
#12279
üzenetére
Függvénnyel ezt nem lehet megoldani, mert vagy a függvényt írod a cellába, vagy azt a karaktert (karaktercsoportot), ami alapján a másik lapról veszi az RGB értékeket.
A Munka1 lap marad, ahogy a #12283-ban megadtam, a másik laphoz rendeld ezt a kódot:
Public lel, R%, G%, B%
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lel, betu As String, cim As String
Dim R%, G%, B%
betu = Target: cim = Target.Address
szin betu, cim
End SubModulba pedig ezt:
Sub szin(betu, cim)
Dim lel, R%, G%, B%
lel = Sheets("Munka1").Range("A:A").Find(betu).Row
R% = Sheets("Munka1").Cells(lel, 2)
G% = Sheets("Munka1").Cells(lel, 3)
B% = Sheets("Munka1").Cells(lel, 4)
Range(cim).Interior.Color = RGB(R%, G%, B%)
End SubMikor a Munka1 lap A oszlopában szereplő adatok közül beviszel egyet a másik lapra, azonnal megkapja az RGB hátteret.
Már csak azt lenne érdemes pontosítani, hogy a másik lap melyik oszlopában, vagy területén érvényesüljön a színezés, mert most az egész lapon működik, és ez valószínűleg felesleges. -
Delila_1
veterán
válasz
tezse66
#12279
üzenetére
A Munka1 lapon vannak a betűkhöz tartozó RGB értékek, a Munka2-n a színezendő cellák.
A makró, amit a gombbal indítasz:Sub szin()
Dim sor As Integer, lel
Dim R%, G%, B%
Sheets("Munka2").Select
For sor = 1 To 11
lel = Sheets("Munka1").Range("A:A").Find(Cells(sor%, "A")).Row
R% = Sheets("Munka1").Cells(lel, 2)
G% = Sheets("Munka1").Cells(lel, 3)
B% = Sheets("Munka1").Cells(lel, 4)
Cells(sor, 1).Interior.Color = RGB(R%, G%, B%)
Next
End SubFire az előző hsz-ben leírta, hogyan kell bevinni a makrót.
-
Delila_1
veterán
válasz
Geryson
#12263
üzenetére
Működik bugizozi Részösszeg függvénye több oszlop szűrése esetén is.
Ha külön táblázatban akarod hozni az értékeket, érdemes egy külön oszlopban összefűzni az A és B értékeit (közöttük egy elválasztó karakterrel, pl. szóközzel). Legyen ez a D oszlop. Ezután a D-re felviszel egy speciális szűrést, ami a minta szerint a G oszlopba teszi az egyedi értékeket. Ezek mellett a Szumha függvény megadja az összegzett értékeket.
-
Delila_1
veterán
válasz
csferke
#12245
üzenetére
1.
Sheets("Bilans").[E14] = Application.WorksheetFunction.Sum(Range(Cells(Target.Row, 5), Cells(Target.Row, 6)))*-1Az [E14] a Range("E14") rövidebb formája.
2.
=IF(LEFT(F29,6)="szöveg", ("fco. naš mag. "&I8&" radnih dana od dana prijema uplate"),)Az utóbbit (is) próba nélkül írtam. A LEFT(F29,6)="szöveg" az F29 cella kezdetét vizsgálja a "szöveg" szó hosszúságában. Ha az F29 tartalma pl. "szöveg a tartományban", akkor a képletet tartalmazó cella eredménye fco. naš mag. szöveg radnih dana od dana prijema uplate – bármit jelentsen is.

Nem szükséges a CONCATENATE függvényt kiírni, elég az összefűzendő értékek közé & jelet írni.
-
Delila_1
veterán
válasz
csferke
#12231
üzenetére
Az If Not Intersect(Target, [D:E]) Is Nothing Then sorban a [D:E]-t írd át [B:C]-re.
Az eseménykezelő makrókban azt kell figyeltetni, ami billentyűzetről változik.
Nincs szükség egy külön oszlopra az összegzéshez a másik lapra történő átvitelhez, a Sum(Range(Cells(Target.Row, 4), Cells(Target.Row, 5))) sor elvégzi az összeadást. A sok képlet lassítja a futást.Nem próbáltam ki!
-
Delila_1
veterán
-
Delila_1
veterán
válasz
coolmpi
#12184
üzenetére
Ez a kérdés valahogy kimaradt.

A csatolt füzet Munka1 lapján látszik, hogy a beléptető automata nem áll a helyzete magaslatán. Néhány sorban az egymást követő időpontokban kissé rapszodikusan követik egymást a be- és kilépések. A lapon piros karakterrel jelöltem ezeket a hibákat.
Készítettem egy másolatot a lapról, ahol – önkényesen – kitöröltem a hibás sorokat. Felvettem 3 új oszlopot, majd az egészből kimutatást készítettem.
Érdemes megnézni az összegző oszlop és -sor cellaformátumát. Ha egyszerűen ó:p alakban adjuk meg ezt, akkor csak a 24 órákon felüli időt mutatja (138:37 helyett 18:37 látszana), mert az alapértelmezett idő az Excelben 1 nap, vagyis 24 óra. -
Delila_1
veterán
válasz
csferke
#12213
üzenetére
Szívesen.
Ezt a Sheet3 laphoz rendeld:Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A:A]) Is Nothing Then
Sheets("Sheet2").[B1] = Application.WorksheetFunction.Sum([D:E])
End If
End SubHa a Sheet3 lapon a D, vagy E oszlop változása után kellene az összegüket átvinni a Sheet2!B1 cellájába, akkor az
If Not Intersect(Target, [A:A]) Is Nothing Thensor helyére
If Not Intersect(Target, [E:D]) Is Nothing Then
kerüljön. Most a Sheet3 lap A oszlopába beírt érték hatására kerül a D:E oszlop összege a Sheet2!B1-be. -
-
Delila_1
veterán
válasz
torment
#12203
üzenetére
A lapnév mindig szöveg formátumú, még ha "szemre" dátumot mutat is.
Szúrj be egy lapot Lista névvel, ide listázza majd ki a lapok makró a dátumos lapneveket.
Sub lapok()
Dim lap%, lapnév As String, usor%
For lap% = 1 To ThisWorkbook.Sheets.Count
lapnév = Sheets(lap%).Name
If Len(lapnév) = 10 And Mid(lapnév, 5, 1) = "." And Mid(lapnév, 8, 1) = "." Then
usor% = Sheets("Lista").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Lista").Range("A" & usor%) = lapnév
End If
Next
End SubA makróban feltételeztem, hogy a lapnevek 2011.12.01 formátumúak. A feltételt tartalmazó sort lehetne bővíteni, pontosítani. Itt csak a lapnév hosszát, és a két pont helyét ellenőriztettem.
-
Delila_1
veterán
válasz
Fehér Mancs
#12199
üzenetére
Ez az igazi!
Magyar Excelben
{=SZUM((A47:EQ47)*(MARADÉK(OSZLOP(A47:EQ47);3)=0))} -
-
Delila_1
veterán
válasz
superecneB
#12169
üzenetére
A szerkesztőlécen beállsz a szövegbe, és Alt+Enterrel töröd a sort. Miért nem működik ez?
-
Delila_1
veterán
válasz
superecneB
#12167
üzenetére
A cellaformázás Igazítás fülén jelöld be a Sortöréssel több sorba opciót.
Úgy is beállíthatod, hogy a szövegben Alt+Entert adsz, ahol törni akarod a szöveget. -
Delila_1
veterán
válasz
Fire/SOUL/CD
#12159
üzenetére
Analyzis ToolPak. Érdemes ennek a VBA-s változatát is bejelölni.
A #11102-es-re kellet volna irányítanom a linket, eltévesztettem.
-
Delila_1
veterán
válasz
Fire/SOUL/CD
#12157
üzenetére
Igen, csak elő kell csalni a bővítményekkel.
-
Delila_1
veterán
válasz
zoli1962
#12155
üzenetére
Még egyszerűbb a RANDBETWEEN függvénnyel, ami azonos a 2010-es VÉLETLEN.KÖZÖTT függvénnyel.
Itt találsz egy kis leírást -
Delila_1
veterán
válasz
Sickboy25
#12139
üzenetére
Lehet, hogy itt-ott nem dátum formátumú az adatod.
Állítsd a teljes oszlopot dátum formátumra, és egyenként enterezd le, de úgy, hogy F2-t nyomsz a cellán, majd Enter. A teljes oszlopon F2-Enter, F2-Enter.Az a cella (G2) is dátum formátumú legyen, ahova a kiválasztott dátumot írod.
-
Delila_1
veterán
válasz
Sickboy25
#12131
üzenetére
Irányított (speciális) szűrőt alkalmazz.
Vegyük, hogy az adataid az A:E tartományban vannak. Az A oszlop tartalmazza a dátumot, az oszlop címe Kelt.
A G1 cella legyen Kelt, G2-be írd a keresendő dátumot, a példa szerinti 2011.09.11-et.
A szűrés párbeszéd doboza ilyen legyen:Más helyre másolja
Listatartomány: $A:$E
Szűrőtartomány: $G1:$G2
Hova másolja: $I$1:$M>1
Csak az egyedi rekordok megjelenítéseKépet akartam beszúrni, de a 15 KB-os, jpg kiterjesztésű képet nem megfelelőnek minősíti a fórummotor. Kiírja, hogy max 1920×1200 px, 1Mb, GIF/JPG/PNG képet tud csak fogadni.
-
Delila_1
veterán
válasz
Dre_Powell
#12121
üzenetére

-
Delila_1
veterán
válasz
Dre_Powell
#12119
üzenetére
=ha(k2<11;14300;k2*1300)
-
Delila_1
veterán
=HA(HIBÁS(FKERES(A526;$A$1:$B$10;2;HAMIS));"";FKERES(A526;$A$1:$B$10;2;HAMIS))
Ez a függvény hibás FKERES esetén – nem találja a keresett értéket – üres stringet ("") ad eredményül, látszólag üres lesz a cella. Találatkor kiírja a keresett értékhez tartozó B cella tartalmát.
-
Delila_1
veterán
válasz
JagdPanther
#12098
üzenetére
Szívesen.

-
Delila_1
veterán
válasz
JagdPanther
#12096
üzenetére
D1-be írtam a keresendő értéket, a számok az A oszlopban vannak.
A képlet
=HOL.VAN(D1;A:A;1)+1
Új hozzászólás Aktív témák
- BESZÁMÍTÁS! Apple MacBook Pro 14 M4 Max 48GB RAM 1TB SSD notebook garanciával hibátlan működéssel
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 64GB RAM RTX 5080 16GB GAMER PC termékbeszámítással
- Csere-Beszámítás! Playstation 5 Slim Disc Edition ( Lemezes Slim PS5 Konzol.)
- Telefon felvásárlás!! iPhone 14/iPhone 14 Plus/iPhone 14 Pro/iPhone 14 Pro Max
- Lenovo Legion Slim 5 Ryzen 7 7840HS 16GB 512GB RTX 4060 OLED 120Hz 1év garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest









Fferi50