-
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
A próbálkozások között törölnöd kellett volna a Havi lap kigyűjtött adatait.
Beírtam a makróba, hogy tegye ezt meg.Sub Kigyujtes()
Dim usor As Long, sor As Long, lap As Integer, WSH As Worksheet
Dim WF As WorksheetFunction
Set WF = Application.WorksheetFunction
Set WSH = Sheets("Havi")
usor = WSH.Range("A" & WSH.Rows.Count).End(xlUp).Row
WSH.Range("A2:K" & usor).ClearContents
For lap = 2 To Worksheets.Count
With Sheets(lap)
.Range("A100:K200").Copy WSH.Range("A" & WF.CountA(WSH.Columns(1)) + 1)
End With
Next
End Sub -
Delila_1
veterán
válasz
Dr. Mózes
#25431
üzenetére
A G oszlopba kigyűjtöd a C egyedi rekordjait (régebbi verziókban Adatok | Szűrő | Irányított, 2007-től Speciális szűrés).
A kép szerinti képleteket beírod az E, F, és I oszlopokba. Azokat a cellákat törölheted, ahol az I oszlopban HAMIS érték van. Kijelölöd az E2:I2 cellákat, Ctrl+ mínusz jel, cellák eltolása felfelé.
Ez utóbbira lehet írni egy makrót.
-
Delila_1
veterán
A
.Rows("2:" & usor).Copy WSH.Range("A" & WF.CountA(WSH.Columns(1)) + 1)sorban a félkövér helyére
Range("A100:K200")-at írj.
Az usor = .Range("A" & .Rows.Count).End(xlUp).Row sor nem kell.
Még a Dim kezdetű sorból is kimaradhat az usor As Long, de nem szükséges kitörölni, nem árt semmit.
-
Delila_1
veterán
Első lapnak betettem egy Havi nevűt, ahova bemásoltam a többi lap címsorát. Minden lapon az első a címsor.
Az összegző makró:
Sub Kigyujtes()
Dim usor As Long, sor As Long, lap As Integer, WSH As Worksheet
Dim WF As WorksheetFunction
Set WF = Application.WorksheetFunction
Set WSH = Sheets("Havi")
For lap = 2 To Worksheets.Count
With Sheets(lap)
usor = .Range("A" & .Rows.Count).End(xlUp).Row
.Rows("2:" & usor).Copy WSH.Range("A" & WF.CountA(WSH.Columns(1)) + 1)
End With
Next
End SubSzerk.: eddig nem szórta szét a fórummotor ilyen randán a sorokat.
-
Delila_1
veterán
válasz
pirit28
#25420
üzenetére
Makróval:
Sub Szetcincal()
Dim adat
If InStr(Selection, "*") > 0 Then
adat = Split(Selection, "*")
Selection.Offset(, 1) = adat(0)
Selection.Offset(, 2) = adat(1)
On Error Resume Next
Selection.Offset(, 3) = adat(2)
Else
Selection.Offset(, 1) = Selection.Value
End If
End SubRáállsz a szétszedendő cellára, és indítod a makrót.
Sajnos saját készítésű függvényt nem lehet rá írni, mert az nem tud a szomszédos cellákba rajzolni. -
#25372
Delila_1
veterán
Sweetraver
#25371
Delila_1
veterán
válasz
Sweetraver
#25371
üzenetére
Egy segédoszlopban a
=DARABTELI($R$2:$AB$31;A2)+DARABTELI($R$2:$AB$31;B2)+DARABTELI($R$2:$AB$31;D2)+DARABTELI($R$2:$AB$31;E2)
képlet megmondja, hogy az A, B, D és E oszlopban lévő számok hányszor fordulnak elő az R:AB tartományban.
-
Delila_1
veterán
válasz
DasBoot
#25262
üzenetére
Nézd meg ezt:
Function LongDec2Bin(ByVal nIn As Long, Optional nBits As Long = 0&) As Variant
'J.E. McGimpsey műve, és Harlan Grove módosítása
Dim nReqBits As Long
Dim sOut As String
Dim sBit As String
Dim bNeg As Boolean
Dim i As Long
If nIn < 0& Then
bNeg = True
nIn = -(nIn + 1&)
End If
If nIn = 0& Then
nReqBits = 1&
Else
nReqBits = Int(Log(nIn) / Log(2&)) + 1& - bNeg
End If
If nBits <= 0& Then nBits = nReqBits
If nBits >= nReqBits Then
If bNeg Then
sOut = String(nBits, "1")
sBit = "0"
Else
sOut = String(nBits, "0")
sBit = "1"
End If
For i = nBits To (nBits - nReqBits + 1&) Step -1
If (nIn - 2& * (nIn \ 2&)) > 0 _
Then Mid(sOut, i, 1&) = sBit
nIn = nIn \ 2&
Next i
LongDec2Bin = sOut
Else
LongDec2Bin = CVErr(xlErrNum)
End If
End Function -
Delila_1
veterán
válasz
wolfman
#25235
üzenetére
Próbáld meg, hogy az első sor minden cellájába írj be bármit, ameddig az oszlopaidban találsz adatokat. Erre a sorra teszel autoszűrőt.
Itt megnézheted, hogy az üres cellákat hogy lehet könnyen kitölteni a fölöttük lévő adatokkal. Azt hiszem, ilyen megoldást is javasolt valaki.
-
-
Delila_1
veterán
válasz
marcyman
#25187
üzenetére
Készíts kimutatást a kép szerint. Az összegző mezőkben látszólag napi összeget ír, de az valójában napi átlag, mint a jobb oldali mezőlista tábla jobb alsó sorában látszik.
Érdemes előtte táblázattá alakítani az adataidat, akkor a kimutatás mindig a friss adatokkal számol.
A dátum legördülőben kiválaszthatod az aktuális dátumot.
-
#25174
Delila_1
veterán
gaborlajos
#25173
Delila_1
veterán
válasz
gaborlajos
#25173
üzenetére
Alkalmazás:
Beírod a 20 cég nevét, amit most nálam az I1:M1 tartomány képvisel. Elé, ahol most nálam a Kategóriák szöveg szerepel, beírod pl. hogy Cégek. Kijelölöd a H1:M1 tartományt, és ha 2003-asnál magasabb verziód van, akkor Képletek | Definiált nevek | Kijelölésből új, Bal oszlopból.
2003-nál és alatta a kijelölés után Beszúrás | Név | Létrehozás.Most beírod az első cég alá a hozzá tartozó emberek nevét. Ez lesz mondjuk az I1:I12 tartomány. Kijelölöd, nevet adsz neki, mint az előbb, csak most a Bal oszlopból helyett a Felső sorból opciót választod. Ezt megismétled a többi cégnél is.
Az első cella (a példa szerint A1) érvényesítése Lista, forrása a =Cégek. Itt rögtön válassz is ki egyet. A második (B1) szintén Lista, a forrása pedig =INDIREKT(A1).
A listáknak nem kell azonos lapon lenniük az érvényesítésekkel. Nálam most mindegyik kategóriában 7 adat van, de természetesen különböző hosszúságúak lehetnek.
-
-
Delila_1
veterán
válasz
Backrau
#25139
üzenetére
Ebben az esetben a laphoz rendelendő makró
Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty(Target) Then Exit Sub
If Target.Column = 2 Then
Application.EnableEvents = False
Cells(Target.Row + 1, 1).EntireRow.Insert
Cells(Target.Row + 1, 1) = Cells(Target.Row, 1)
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
válasz
Backrau
#25136
üzenetére
Úgy érted, hogy ha a B oszlopba beírsz valamit, akkor annak a sornak az A cellájában jelenjen meg az aktuális dátum?
Ha igen, rendeld a lapodhoz a nyúlfarknyi makrót.
Private Sub Worksheet_Change(ByVal Target As Range)
If IsEmpty(Target) Then Exit Sub
If Target.Column = 2 Then Cells(Target.Row, 1) = Date
End SubEzután makróbarátként kell mentened a füzetedet.
-
Delila_1
veterán
válasz
KERO_SAN
#25105
üzenetére
Két makró kell hozzá. Az első figyeli a 18. oszlop kitöltését, majd indítja a másikat, ami a másolást végzi el. A laphoz rendeléshez, és a modulba tevéshez sok leírás van itt a fórumon.
Nem kell előre elkészíteni a 10 lapot, a makrók létrehozzák "1"-től "10"-ig névvel.Az alap táblázatot tartalmazó laphoz rendeld:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LapNev As String
If IsEmpty(Target) Then Exit Sub
If Target.Column = 18 Then
LapNev = Cells(Target.Row, 1)
Masolas Target.Row, LapNev
End If
End SubModulba helyezd:
Sub Masolas(sor, LapNev)
Dim a As Object, usor As Long
Dim ElsoLap As Worksheet
Set ElsoLap = Worksheets(ActiveSheet.Name)
On Error Resume Next
Set a = Sheets(LapNev)
If Err.Number <> 0 Then
Worksheets.Add.Name = LapNev
ElsoLap.Rows(1).Copy Sheets(LapNev).Range("A1")
End If
On Error GoTo 0
usor = Sheets(LapNev).Range("A" & Rows.Count).End(xlUp).Row + 1
ElsoLap.Rows(sor).Copy Sheets(LapNev).Range("A" & usor)
ElsoLap.Move Before:=Sheets(1)
End Sub -
Delila_1
veterán
válasz
KERO_SAN
#25097
üzenetére
Még azt kellene tudni, hogy a 18. oszlop kötelezőn kitöltendő-e?
Ha igen, akkor ennek a kitöltéséhez lehet rendelni egy eseménykezelő makrót, ami a bevitel után azonnal automatikusan átmásolja a teljes sort a megfelelő lap első üres sorába.
Ha nem, akkor pl. egy gombot lehet kitenni az első lapra, amit minden sor teljes kitöltése után megnyomsz, vagy ez a gomb egyszerre szortírozza a teljes első táblázatot 10 felé.
-
Delila_1
veterán
válasz
KERO_SAN
#25067
üzenetére
Kicsit több információ kellene.
Van 1+10 táblázatod? Hol van (külön lapon, másik füzetben) a 10?
Attól függően, hogy az első táblázat A oszlopába mekkora számot írsz 1 és 10 között, másolja vagy helyezze át a teljes sort a további 10 valamelyikébe?
Hány oszlopot kell másolni egy-egy új szám beírásakor? Ha a 10 tábla 10 lapon van, mi ezeknek a lapoknak a neve? -
#25088
Delila_1
veterán
atillaahun
#25087
Delila_1
veterán
válasz
atillaahun
#25087
üzenetére
Nincs mit.
-
#25066
Delila_1
veterán
atillaahun
#25065
Delila_1
veterán
válasz
atillaahun
#25065
üzenetére
A RÉSZÖSSZEG függvényt nézd meg.
-
-
-
Delila_1
veterán
válasz
alfa20
#25031
üzenetére
Nem tudom, mit akarsz megjeleníteni (óra.perc, perc.másodperc) formában.
A lenti makró ó:pp:mm formában írja ki a futási időt.
A cellába való beírást megjegyzésbe tettem. Próbáld meg írással, és anélkül.Sub valami()
Dim t, b As Double
t = Now
For b = 1 To 300000000
' Cells(1, 1) = b
Next
MsgBox Format(Now - t, "h:mm:ss"), , "Futási idő"
End Sub -
#25027
Delila_1
veterán
agyhalottak
#25015
Delila_1
veterán
válasz
agyhalottak
#25015
üzenetére
Szép hosszú lesz az A5:Asok tartomány feltételes formázásának a képlete.
=ÉS(HOL.VAN("x";A5:BC5;1)>=7;INDEX(A5:BC5;1;HOL.VAN("x";A5:BC5;1)-1)="";INDEX(A5:BC5;1;HOL.VAN("x";A5:BC5;1)-2)="";INDEX(A5:BC5;1;HOL.VAN("x";A5:BC5;1)-3)="")
-
Delila_1
veterán
válasz
Geryson
#25007
üzenetére
Az Adatok | Rendezés és szűrés | Speciális menüpont szerint szűrheted kedved szerinti oszlopokra és értékekre a tartományodat.
Fel kell venned egy kritérium tartományt, ami az "igen" oszlopod címét, és alatta az igen szót tartalmazza. Egy másik tartomány azoknak az oszlopoknak a címe legyen, amiket az új tartományban akarsz szerepeltetni (és olyan sorrendben, ahogy majd kellenek). A kritérium oszlopnak nem kell feltétlenül szerepelnie ebben a tartományban.
A két, előre meghatározott tartomány hátterét színeztem.
-
Delila_1
veterán
válasz
alfa20
#24938
üzenetére
Nagyon klassz! Most már csak azt nem értem, ha az ikonját kitetted a gyorselérési eszköztárra, miért nem magát a kalkulátort tetted ki?
Ujjgyakorlat a makrózáshoz?
Akkor egy kis formázási módosítás:
A Display label SpecialEffect tulajdonságánál a 2-es jobban mutat.
A Label2 lehet nagyobb, de a Visible tulajdonsága legyen False
A Label1 BackStyle legyen 0, átlátszó, hogy a Display labelt ne takarja.Persze ízlések és pofonok...
-
Delila_1
veterán
Egyenként kell megadnod a feltételes formázást a különféle nagyságrendekhez, de ezt elég 1× bevinned a tartományra.
100-as nagyságrendnél nagyobbhoz a feltétel =A2>999, a forma ##0 " ezer" (a 0 után 1 db szóköz)
100 000-esnél nagyobbhoz =A2>999999, a forma ### ##0 " millió" (a 0 után 2 db szóköz)Figyeld meg, hogy a számfora utolsó tagja, a 0 után annyi szóköz van, ahányszor 1-1 hármas egység szerepel az eredeti értékben. Az idézőjelen belülre is tettem egy kezdő szóközt, az csak annyit csinál, hogy
123ezer helyett 123 ezer lesz a kiírás képe, nem írja rá a számra a nagyságrendet. -
Delila_1
veterán
A =KÖZÉP(A1;SZÖVEG.KERES(" ";A1)+1;80) nem makró, hanem egy képlet. Egy üres oszlopba írd be az első (dupla) szavad sorába, majd másold le addig, amíg adataid vannak.
Vagy egyszerre beírhatod a képletet a D oszlopba, D2-től addig, ameddig adatok vannak az A oszlopban.
Ez a makró modulban legyen. A Munka1 helyett írd a saját lapod nevét.Sub angol()
Dim usor As Long
usor = Application.WorksheetFunction.CountA(Sheets("Munka1").Range("A:A"))
Range("D2:D" & usor) = "=MID(A2,SEARCH("" "",A2)+1,256)"
End Sub -
Delila_1
veterán
A laphoz kell rendelned a makrót. Feltételeztem, hogy az első oszlopban vannak a szavak. Ha nem, akkor az
If Target.Column = 1 And Not IsEmpty(Target) Then
sorban az 1-et írd át a formázandó oszlop sorszámára.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim kezd As Integer
If Target.Column = 1 And Not IsEmpty(Target) Then
kezd = InStr(Target, " ") + 1
Range(Target.Address).Characters(Start:=kezd, Length:=Len(Target)).Font.FontStyle = "Italic"
End If
End SubEz a makró az újonnan bevitt magyar-angol szöveg második részét alakítja dőlt betűssé.
Az angol szavakat a =KÖZÉP(A1;SZÖVEG.KERES(" ";A1)+1;80) képlettel kapod meg egy üres oszlopban. -
Delila_1
veterán
Egyszerűen kitöltheted az üres helyeket.
Kijelölöd a B6:D14 területet. Ctrl+g-re bejön az ugrás menü, ahol az irányítottat, majd az üres cellákat választod. Marad a kijelölés, az aktuális cellába beírsz egy egyenlőség jelet, majd FEL nyilat nyomsz, Ctrl+Enter.Ezután már csak a képletet kell beírni a B3-ba: =FKERES(B2;$A$6:$D$14;OSZLOP();1), és ezt jobbra másolni.
-
Delila_1
veterán
válasz
alfa20
#24917
üzenetére
Label-ben nem tudsz értékeket megadni, erre a Textbox való. Mivel a textboxok szöveges értéket adnak (a nevükben is ez szerepel), meg kell szoroznod azokat 1-gyel, hogy számolni lehessen velük.
A képen a lévő ComboBox RowSource tulajdonságába ezt írtam: Munka1!A1:A2, mert ebbe a két cellába írtam a + és - jelet, előttük aposztróffal.
-
Delila_1
veterán
válasz
vigyori78
#24865
üzenetére
Most nem tudom megnézni, de valószínű, hogy ebben a menüpontban módosítani tudod a csatolást. Ha igen, akkor a saját füzetedet tallózd ki itt, arra kell átirányítanod a csatolásokat.
Másik módszer, hogy szögletes zárójelet keresel a füzetedben, és egyenként törlöd a külső hivatkozásokat.
-
Delila_1
veterán
válasz
BenJoe80
#24845
üzenetére
1. Az Application.EnableEvents = False sor letiltja, hogy az eseménykezelő makró újra lefusson, mikor a Left függvény beírja az első 4 karaktert a D oszlopba, majd True-ra állítva ismét engedélyezi a futást.
A Worksheet_SelectionChange típusú makró minden esetben lefut, mikor új adat kerül billentyűzetről a lapra, ilyen az egérrel kiválasztott adat is. Mindkét makró a beírt értéket felülírja egy rövidebb értékkel, ami újabb beírás, ismételten lefut a makró, ha nem tiltjuk ezt le. Ezúttal a 4 karakterből álló adat 4 első karakterét venné, ami gyakorlatilag nem változtat az új beíráson.
Mivel alkalmanként az ideiglenes letiltás csupán 1 újabb futást "takarít meg", nem látható a futási idő rövidülése. Enélkül is elmegy.2. Nem maga az érvényesítés legördülője lett szélesebb, hanem a kiválasztáskor az általam feltett füzetben még üres a következő oszlop, ezért abban (is) látszik a kiválasztott, több karakterből álló szöveg.
-
Delila_1
veterán
válasz
BenJoe80
#24823
üzenetére
Feltettem ide.
Az Acc. lap C oszlopában összefűztem a kétféle adatot, közöttük pár szóközzel. A sárga hátterű tartománynak a lista nevet adtam. Ezt vittem érvényesítésként a January lap B oszlopába. Nem valószínű, hogy ebben az oszlopban kellene választanod, de nem írtad, melyikben szeretnéd.
-
Delila_1
veterán
-
Új hozzászólás Aktív témák
- Fotó állvány eladó
- BESZÁMÍTÁS! 4TB Seagate Barracuda ST4000 SATA HDD meghajtó garanciával hibátlan működéssel
- Dell Latitude 7280,12.5",HD,i5-6200U,8GB DDR4,256GB SSD,WIN11
- Apple iPhone 16 Pro Max 256GB - Kártyafüggetlen, Sivatagszín, 91% Akku - 1 Év Garanciával
- Dell Latitude 7300 Core i5-i7, 8-16GB RAM, SSD, jó akku, számla, 6 hó gar
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest