- Luck Dragon: Asszociációs játék. :)
- Andras-G: Az internet veszélyei [2. rész] - Facebook Marketpalce
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Luck Dragon: Alza kuponok – aktuális kedvezmények, tippek és tapasztalatok (külön igényre)
- mefistofeles: Az elhízás nem akaratgyengeség! 2 Ahogy én csinálom.......
-
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
Egy segédoszlopban összefűzöd az egyes cellákat valami elválasztó karakterrel (szóköz, alsó kötőjel), olyan sorrendben, ahogy a rendezést szeretnéd látni. A kép szerint az első az idő, második vagy a gép, vagy a TervAzon. A mutatott adatok szerint bármelyik lehet. Akárhány oszlopod adatait is összefűzheted, majd eszerint rendezd a teljes tartományt.
-
Delila_1
veterán
válasz
Evuska
#36021
üzenetére
Az első 3 oszlop zárolása után valószínűleg levédted a lapot.
Rendeld a laphoz a lenti makrót (lásd a Téma összefoglalót).Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="Saját_jelszavad", UserInterfaceOnly:=True
If Target.Column = 4 Then Range(Target.Address).Locked = True
End SubA "Saját_jelszavad" helyére írd be az igazi jelszót.
-
Delila_1
veterán
válasz
Sprite75
#36008
üzenetére
Feltettem egy fájlt.
Az R1 cellában választhatod ki az üzletet, az S1-be írja ki a sofőr nevét.A minta szerint átalakíthatod az S1 képletét a saját igényed szerint.
Szerk.: a B1, E1 ... N1 cellákban a sofőr neve legyen, a többi szöveget szövegdobozba, vagy megjegyzésbe írd.
-
Delila_1
veterán
válasz
PerezT
#35996
üzenetére
3 helyen, a csillagozott sorokban kell módosítanod a makrót.
Nálam Munka1 a kiinduló lap neve, és Munka2, ahova átrendezve bemásolja az értékeket.A sorIde = 1: oszlopIde = 1 változók értékei adják meg, hogy a 2. lapon hol kezdődjön a tábla, ami itt az A1-es cella sora, és oszlopa.
Sub transz()
Dim sor As Long, usor As Long, sorIde As Long
Dim oszlop As Integer, uoszlop As Integer, oszlopIde As Integer
Sheets("Munka1").Select '***
uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
usor = Range("A" & Rows.Count).End(xlUp).Row
sorIde = 1: oszlopIde = 1 '***
With Sheets("Munka2") '***
For oszlop = 2 To uoszlop
For sor = 2 To usor
.Cells(sorIde, oszlopIde) = Cells(1, oszlop)
If Cells(sor, oszlop) > "" Then
.Cells(sorIde, oszlopIde + 1) = Cells(sor, 1)
.Cells(sorIde, oszlopIde + 2) = Cells(sor, oszlop)
sorIde = sorIde + 1
End If
Next
Next
End With
End Sub -
Delila_1
veterán
válasz
PerezT
#35994
üzenetére
Arra az esetre, ha az első táblázatod az A1 cellában kezdődik, egy makró gyorsan átmásolja a kívánt formába az adataidat. A makrót modulba kell tenned (lásd a Téma összefoglalóban).
Sub transz()
Dim sor As Long, usor As Long, sorIde As Long
Dim oszlop As Integer, uoszlop As Integer, oszlopIde As Integer
uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
usor = Range("A" & Rows.Count).End(xlUp).Row
sorIde = 1: oszlopIde = 15
For oszlop = 2 To uoszlop
For sor = 2 To usor
Cells(sorIde, oszlopIde) = Cells(1, oszlop)
If Cells(sor, oszlop) > "" Then
Cells(sorIde, oszlopIde + 1) = Cells(sor, 1)
Cells(sorIde, oszlopIde + 2) = Cells(sor, oszlop)
sorIde = sorIde + 1
End If
Next
Next
End Sub -
Delila_1
veterán
-
Delila_1
veterán
válasz
föccer
#35928
üzenetére
Dim a
On Error Resume Next
Set a = Sheets(Range("C2"))
If Err.Number <> 0 Then
Sheets.Add.Name = Range("C2")
On Error GoTo 0
End If
Columns("A:D").ColumnWidth = 20Az alsó sor az A:D oszlopok szélességét állítja be, és teszi ezt az újonnan létrehozott lapon, mert hivatalból az új lap az aktív. Ha másik lapon akarod a szélességet beállítani, akkor ezt jelezni kell.
Sheets(1).Columns("A:D").ColumnWidth = 20 -
Delila_1
veterán
-
Delila_1
veterán
válasz
föccer
#35879
üzenetére
Rossz hírem van. A másolandó tartománynak először a formátumát másolom a másik lapra, hogy azonosak legyenek a cellaegyesítések. Ennek ellenére az azonos formátumú másolandó területet nem képes az Excel beilleszteni. A lenti makróban kihagyhatod a csillagokkal jelzett sort, mert ott megbukik. Meg kell szüntetned az egyesítéseket, akkor jó lesz.
Sub Masolas()
Dim sor As Long
If Sheets(2).Range("A5") = "" Then
sor = 5
Else
sor = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 2
End If
Sheets(1).Range("AD18:AD21").Copy
Sheets(2).Range("A" & sor).PasteSpecial xlPasteFormats '***
Sheets(2).Range("A" & sor).PasteSpecial xlPasteValues
End Sub -
Delila_1
veterán
válasz
föccer
#35863
üzenetére
Szűrés után futtathatod a modulba másolt makrót.
Sub sorszam()
Dim sor As Long, oszlop As Integer
For sor = 23 To 1000
If Rows(sor).Hidden = False Then
For oszlop = 1 To 5
Cells(1, oszlop) = Cells(sor, oszlop)
Next
For oszlop = 15 To 24
Cells(1, oszlop) = Cells(sor, oszlop)
Next
Exit Sub
End If
Next
End Sub -
Delila_1
veterán
válasz
sinkoati85
#35847
üzenetére
Ez egy ListBox. Jobb klikk rajta, Delete.
-
Delila_1
veterán
válasz
Mela Kehes
#35835
üzenetére
Kimutatást kell készítened pár kattintással. Ebben az oszlopodat, ami a sikerült - nem sikerült értékeket mutatja, szűrd a "sikerült"-re.
-
Delila_1
veterán
válasz
Mela Kehes
#35813
üzenetére
Ha a nevet tartalmazó oszlop jobbra van a keresett értéktől, akkor az FKERES is alkalmazható.
-
Delila_1
veterán
válasz
lenkei83
#35810
üzenetére
Másik megoldás (Feriéhez képest): tedd keretbe a CheckBoxokat, és egy gombhoz rendeld a lekérdezést.
Private Sub CommandButton1_Click()
Dim i As Object, f As Boolean
For Each i In Frame1.Controls
If i = False Then f = True
Next
If f Then MsgBox "Nincs minden jejölőnégyzet bejelölve", vbInformation
End Sub -
Delila_1
veterán
válasz
Mela Kehes
#35808
üzenetére
INDEX és HOL.VAN.
-
Delila_1
veterán
válasz
NemszakiTomi
#35733
üzenetére
Nézd meg a cellaformátumot is! Van egy formátum – ;;; –, ami láthatatlanná teszi a cella tartalmát.
-
Delila_1
veterán
válasz
Acustic
#35720
üzenetére
Szia Attila!
Az első makrót a laphoz kell rendelned. Mikor a H oszlopba beírsz, vagy bemásolsz egy nevet, akkor ez a cella, valamint az A oszlopban lévő, azonos tartalmú cellák háttere sárga lesz. Az első, A oszlopban lévő név cellája lesz kijelölt.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ter As Range, CV As Object
If Target.Column = 8 Then
Set ter = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each CV In ter
If CV = Target Then
CV.Interior.Color = vbYellow
CV.HorizontalAlignment = xlRight
CV.VerticalAlignment = xlTop
End If
Next
Range(Target.Address).Interior.Color = vbYellow
Range(Target.Address).HorizontalAlignment = xlRight
Range(Target.Address).VerticalAlignment = xlTop
Range("A" & Application.WorksheetFunction.Match(Target, Columns(1), 0)).Select
End If
End SubA második makró modulba kerül. Ehhez rendelj billentyű kombinációt, aminek hatására indul a makró. Az aktuális cella háttere piros lesz, a kijelölés a következő, ilyen nevet tartalmazó cellára ugrik az A oszlopban. Mikor a kombinációval befejezted a szereplőhöz tartozó összes cella átszínezését, a H oszlopban is pirosra vált a név cellája, ez lesz kijelölt. Üzenetet kapsz, hogy a szereplő összes sora kész van.
Sub Piros()
Dim sor, nev As String
If Selection.Column = 1 Then
nev = Selection.Value
On Error GoTo KeszVan
sor = Range("A" & Selection.Row + 1 & ":A10000").Find(nev).Row
Selection.Interior.Color = vbRed
Selection.HorizontalAlignment = xlLeft
Cells(sor, "A").Select
End If
Exit Sub
KeszVan:
Selection.Interior.Color = vbRed
Selection.HorizontalAlignment = xlLeft
sor = Columns(8).Find(nev).Row
Cells(sor, "H").Interior.Color = vbRed
Cells(sor, "H").HorizontalAlignment = xlLeft
Cells(sor, "H").Select
MsgBox nev & " minden sora kész van.", vbInformation, "Értesítés"
End SubJó munkát! Üdv
Kati -
Delila_1
veterán
válasz
Acustic
#35716
üzenetére
Ha jól értem, a H oszlopba írod be az aktuális szereplő nevét. Ekkor az A oszlopban lévő, ilyen nevű szereplőt tartalmazó cellák váljanak sárga hátterűvé, felül jobbra rendezetté. Mikor új nevet adsz meg a H oszlopban, az előbbi cellák legyenek piros hátterűek, felül balra rendezettek, és az újonnan megadott név cellái sárgák, felül jobbra rendezettek.
A laphoz rendeld a makrót (lásd a téma összefoglalóban).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ter As Range, CV As Object
If Target.Column = 8 Then
Set ter = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each CV In ter
If CV.Interior.Color = vbYellow Then
CV.Interior.Color = vbRed
CV.HorizontalAlignment = xlLeft
CV.VerticalAlignment = xlTop
End If
If CV = Target Then
CV.Interior.Color = vbYellow
CV.HorizontalAlignment = xlRight
CV.VerticalAlignment = xlTop
End If
Next
End If
End SubRemélem, így gondoltad. Ha nem, akkor vagy segít valaki, vagy délután én átírom a makrót.
-
Delila_1
veterán
válasz
Carasc0
#35682
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [I16:I35]) Is Nothing Then
If Target >= 3 And Target < 5 Then
Cells(Target.Row, "AZ") = "I"
Cells(Target.Row, "AZ").Locked = True
End If
If Target >= 5 Then
Cells(Target.Row, "BE") = "I"
Cells(Target.Row, "BE").Locked = True
End If
End If
End Sub -
Delila_1
veterán
válasz
Carasc0
#35680
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True '****
If Not Intersect(Target, [I16:I35]) Is Nothing Then
If Target >= 3 Then
Cells(Target.Row, "AZ") = "I"
Cells(Target.Row, "AZ").Locked = True
End If
End If
End Sub -
Delila_1
veterán
válasz
Carasc0
#35675
üzenetére
Az AZ16 eleve legyen zárolt, az I16 pedig nem.
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True '**********
If Target.Address = "$I$16" And Target >= 3 Then
Range("AZ16") = "I"
Range("$I$16").Locked = True
End If
End Sub -
Delila_1
veterán
válasz
Carasc0
#35669
üzenetére
Ez a makró akkor fut le, ha a lapon bármelyik cellába billentyűzetről viszel be adatot. Mivel nem az A1-be pötyögtetsz, azt a cellát kell figyeltetni, amelyiknek az értékétől függően az A1 ilyen, vagy olyan értéket vehet fel.
Add meg konkrétan, melyik cellákat módosítod, és ezeknek a hatására melyik tartomány módosul. Továbbá, hogy milyen érték(ek)nél kell zárolni a tartományt.
-
Delila_1
veterán
válasz
Carasc0
#35665
üzenetére
Vedd le a zárolást az A1 celláról, meg a többiről, amikbe írhat a felhasználó.
Rendeld a laphoz a lenti makrót.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
If Target = "Gólyacsőr" Then '***********
Range("A1").Locked = True
ActiveSheet.Protect Password:="aaa", UserInterfaceOnly:=True '************
End If
End If
End SubA csillagokkal jelzett sorokon kell változtatnod. Az elsőben a "Gólyacsőr" helyére azt írd be, aminek a bevitele után nem akarod engedni az A1 módosítását, a másodikban az "aaa" helyén legyen a saját lapvédelmed jelszava.
-
-
Delila_1
veterán
Nem az a baj, hanem az, hogy nem vettem figyelembe a sortörlések alapszabályát. Eszerint a törlési ciklust az alsó sortól felfelé kell indítani.
Sub Torles()
Dim sor As Long, usor As Long
Application.ScreenUpdating = False
usor = Range("A" & Rows.cunt).End(xlUp).Row
For sor = usor To 2 Step -1
If Cells(sor, "J") = "-" And Cells(sor, "G") <> "Alma*" And _
Cells(sor, "G") <> "Körte*" And Cells(sor, "G") <> "Narancs*" Then _
Rows(sor).Delete Shift:=xlUp
Next
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
Próbáld ki ezt:
Sub mm()
Dim sor As Long, usor As Long, WF As WorksheetFunction
Dim ter As Range, CV As Range
Set WF = Application.WorksheetFunction
If WF.CountIf(Columns(7), "Alma*") + WF.CountIf(Columns(7), "Körte*") _
+ WF.CountIf(Columns(7), "Narancs*") > 0 Then
usor = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$A$1:$K$" & usor).AutoFilter Field:=10, Criteria1:="-"
usor = Range("J" & Rows.Count).End(xlUp).Row
Set ter = Range("G2:G" & usor).SpecialCells(xlCellTypeVisible)
For Each CV In ter
If CV <> "Alma*" And CV <> "Körte*" And CV <> "Narancs*" Then _
Rows(CV.Row).Delete Shift:=xlUp
Next
usor = Range("J" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("$A$1:$K$" & usor).AutoFilter Field:=10
End If
End Sub -
Delila_1
veterán
válasz
JagdPanther
#35625
üzenetére
Örülök, hogy sikerült, szívesen.

-
Delila_1
veterán
válasz
JagdPanther
#35622
üzenetére
Töröld a laphoz rendelt makrót, a modulban lévőt írd át.
Sub Masol()
Dim sor As Long
sor = Selection.Row
With Sheets("Számla")
.Range("B12") = Cells(sor, "E")
.Range("B28") = Cells(sor, "F")
.Range("H12") = Cells(sor, "J")
.Range("D10") = Cells(sor, "N")
End With
End SubA füzetben a Makrók menüben (Alt + F8), a Masol makrót kiválasztva az Egyebek almenüben bill. kombinációt rendelhetsz hozzá.
-
Delila_1
veterán
válasz
JagdPanther
#35619
üzenetére
Az Ebay laphoz rendeltem egy makrót.
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Masol Target.Row
Cancel = True
End SubModulba jön a másik.
Sub Masol(sor)
With Sheets("Számla")
.Range("B12") = Cells(sor, "E")
.Range("B28") = Cells(sor, "F")
.Range("H12") = Cells(sor, "J")
.Range("D10") = Cells(sor, "N")
End With
End SubAz Ebay lapon egy sor valamelyik celláján jobb klikk, indul az eseményvezérelt makró, majd indítja a másolást.
Rendelheted más eseményhez is. -
Delila_1
veterán
válasz
Pulsar
#35618
üzenetére
Feltöltöttem egy fájlt.
A Munka1 lapon az eredeti elrendezésben van a táblázatod. Itt egy elég összetett képlettel sikerült összehozni a műszakok jelét, de csak a hónap 21. napjáig, mert onnan kezdve az oszlopoknak 2 karakterből áll a betűjele. Ki lehetett volna bővíteni a képletet, de minek.A Munka2 lapon transzponáltam a táblázatodat, így már rövidebb képlettel sikerül elérni az eredményt.
-
Delila_1
veterán
válasz
Pulsar
#35616
üzenetére
Csak a nappalos műszak elejét és végét adtad meg, ami 12 órát foglal magában. A közölt képen is N és É van, az A; B; C és D betűket nem tudtam mire vélni.
Nálatok egy nap 48 óra?
Az előzőek szerint már össze tudod állítani a táblázatodat. Ha nagyon nem megy, itt valószínűleg kapsz segítséget.
-
Delila_1
veterán
válasz
Pulsar
#35614
üzenetére
Az E oszlopba betettem a nevezetes időpontokat. Ezek vannak a G oszlopban is, de már általános formátumban (G1-> =E1). A G1:G6 tartományt érdemes saját magára értékként beilleszteni, akkor az E1:E6 feleslegessé válik, törölhető. A B oszlop képlete a G1:H6 tartományra hivatkozik, mikor itt keresi az A oszlopból képzett időpontot. A G:H tartományt teheted máshova is.
A B1 cella képlete lehet az INDEXes helyett
=FKERES(IDŐ(ÓRA(A1);PERC(A1);0);$G$1:$H$6;2) -
Delila_1
veterán
válasz
maestro87
#35604
üzenetére
Ezért írtam a "gyalogos" képletet.
Megoldhatod csoportba foglalással is, csak ott az A oszlopban azonos adatoknak kell lenniük az összegzendő B számok mellett. Ilyenkor a Részösszeg beszúrásakor vedd ki a pipát az "Összeg az adatok alatt" opció elől.
Hátránya, hogy 2× szerepel majd az összeg, 1× végösszegként, 1× meg mint a csoport összege.Szerk.:
Másik hátrány, hogy új sor felvitelekor újra kell kezdeni a csoportosítást.
-
Delila_1
veterán
A refedit rákattintáskor a benne kijelölt területet teszi be egy string típusú változóba, amit kiértékelhetsz. Példa:
Private Sub CommandButton1_Click()
If Range(RefEdit1) < 10 Then
MsgBox "10-nél nagyobb számot tartalmazó cellát kell választanod!", vbExclamation
RefEdit1 = ""
RefEdit1.SetFocus
End If
End Sub -
Delila_1
veterán
válasz
kacsaesokos
#35461
üzenetére
Nincs mit, szívesen.

-
Delila_1
veterán
válasz
kacsaesokos
#35458
üzenetére
Azért nem jön össze, mert a költséghelyek lapon a adatok végén szóközök vannak.
A TRIM függvénnyel levághatod egy segédoszlopban, majd a megtisztított adatokat értékként beillesztheted az eredeti helyre, a C oszlopba.
-
Delila_1
veterán
válasz
aclandiae
#35430
üzenetére
D. Kijelölöd a tartományt (egy tetszőleges cellára állsz a táblázatodban, Ctrl+a, vagy Ctrl+t). Behozod a Ugrás menüt a Ctrl+g-vel, Irányított, Állandók.
E. Ha már bekapcsoltad az Autoszűrőt, a méret legördülőjén klikk. A felsorolásnál kiveszed a pipát az összes kijelölése elől, és kiválasztod a látni kívánt tételt.
C. A nullákat (látszólag) másképp is eltüntetheted. Az Excel beállításainál Speciális, Beállítások megjelenítése ehhez a munkalaphoz, majd kiveszed a pipát a Nulla megjelenítése a nulla értékű cellákban négyzet elől.
-
Delila_1
veterán
válasz
Juditta_56
#35405
üzenetére
Operation:=xlNone, SkipBlanks:=False, Transpose:=FalseMikor ezeket elhagyod, az xlPasteValues elé sem kell kiírnod a Paste:= -t.
Új hozzászólás Aktív témák
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- PC Game Pass előfizetés
- Xbox / Microsoft Store feltöltőkártya kód (digitális, HU) több címlet, több db, azonnal, olcsón
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Beszámítás! Asus TUF A16 FA608UH FHD Gamer notebook - R7 260 16GB DDR5 512GB SSD RTX 5050 8GB
- Hp 830 G7 Core i7 10610U 16Gb 512Gb NVMe FullHD IPS Boltból Számlával Garanciával
- MEDION ERAZER Cooling Kit V2 Vízhűtés - MD 62737 Beast 16 X1 gamer laptophoz
- 0perces DDR5 4800 vadiúj Ramaxel 2x12GB memória 1 év garancia
- LENOVO L13 Yoga 360 touch - 13,3" - i5 10210U, 8GB RAM, SSD, jó akku, - számla, 6 hó gar
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest







