Hirdetés
- Poco X8 Pro Max - nem kell ide sem bank, sem akkubank
- Samsung Galaxy S26 Ultra - fontossági sorrend
- Samsung Galaxy Watch (Tizen és Wear OS) ingyenes számlapok, kupon kódok
- Fotók, videók mobillal
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- CMF Phone 1 - egy jó telefon
- Külföldi prepaid SIM-ek itthon
- Milyen okostelefont vegyek?
- iPhone topik
- Xiaomi 15 - kicsi telefon nagy energiával
-
Mobilarena
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
Bishop1
#16858
üzenetére
Figyelmesebben átolvasva azt szeretnéd, ha az új, dátum nevű lapokon a"t "lap címsora (A1:D1 tartomány) jelenne meg a második sorban, az A1 cellában pedig a dátum. Ha jól értem, nincs szükség az autoszűrő ki-bekapcsolására, csak a felső sort kell másolni.
Javaslom, hogy a bővítménykezelőben kapcsold be az Analysis ToolPak és az Analysis ToolPak -VBA bővítményeket, mert valószínű, hogy ezeknek a hiánya miatt futott hibára az előző verzió. Ezekkel kapsz egy halom hasznos új függvényt.
Sub Gomb80_Kattintás()
Dim lap As Integer, szam, ujnev
Sheets(1).Select
lap = Worksheets.Count
If Left(Sheets(lap).Name, 10) = CDate(Date) And Len(Sheets(lap).Name) > 11 Then
szam = Right(Sheets(lap).Name, Len(Sheets(lap).Name) - 12)
ujnev = szam + 1
Sheets.Add After:=Sheets(lap)
ActiveSheet.Name = Date & "_" & ujnev
Else
Sheets.Add After:=Sheets(lap)
ActiveSheet.Name = Date & "_1"
End If
Sheets("t").Range("A1:D1").Copy Sheets(lap + 1).Range("A2")
Sheets(lap + 1).Select
Range("A1") = Date
Columns("A:A").ColumnWidth = 24
Sheets("napi").Select
End Sub -
Bishop1
tag
válasz
Bishop1
#16858
üzenetére
Erre jutottam végül kis segítséggel, de ez nem számlálja az oldalakat, vagyis ha aznap még egy munkalapot nyitnék akkor hibaüzenetet ad az azonos munkalap nevek miatt. Ezt továbbgondolva, mi a módja hogy ha ilyenkor nyitáskor azonos munkalap nevet talál felülírja a frissebbel?
Sub Gomb80_Kattintás()
'
' Gomb80_Kattintás Makró
'
'
Sheets("t").Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$D$66").AutoFilter Field:=3, Criteria1:="<>"
Selection.Copy
Sheets.Add(After:=Worksheets(Sheets.Count)).Name = Date
Columns("A:A").ColumnWidth = 24
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "2/23/2013"
Sheets("t").Select
Selection.AutoFilter
Sheets("napi").Select
Range("O8").Select
End Sub -
Delila_1
veterán
válasz
Bishop1
#16852
üzenetére
Második kérdés. A Gyűjtő nevű lap C:D oszlopába gyűjti ki a 20-szal kezdődő nevű napok C1:D1 cellájának az adatait.
Sub C1D1()
Dim usor As Integer, lap As Integer
For lap = 1 To Worksheets.Count
If Left(Sheets(lap).Name, 2) = "20" Then
usor = Sheets("Gyűjtő").Cells(Rows.Count, "C").End(xlUp).Row + 1
Sheets(lap).Range("C1:D1").Copy Sheets("Gyűjtő").Range("C" & usor)
End If
Next
End Sub -
Delila_1
veterán
válasz
Bishop1
#16852
üzenetére
Az első kérdésre a makró:
Sub Gomb80_Kattintás()
Dim lap As Integer, szam, ujnev
Sheets(1).Select
lap = Worksheets.Count
If Left(Sheets(lap).Name, 10) = CDate(Date) And Len(Sheets(lap).Name) > 11 Then
szam = Right(Sheets(lap).Name, Len(Sheets(lap).Name) - 12)
ujnev = szam + 1
Sheets.Add After:=Sheets(lap)
ActiveSheet.Name = Date & "_" & ujnev
Else
Sheets.Add After:=Sheets(lap)
ActiveSheet.Name = Date & "_1"
End If
Sheets(1).Select
Range("A1").Select
Selection.CurrentRegion.Select
lap = Worksheets.Count
Selection.Copy Sheets(lap).Range("A1")
Sheets(lap).Select
Selection.AutoFilter
Columns("A:A").ColumnWidth = 24
End Sub
Új hozzászólás Aktív témák
Hirdetés
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Játékkulcsok olcsón: Steam, Uplay, GoG, EA, Xbox stb.
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- MS SQL Server 2016, 2017, 2019
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Intel Core i9-10850K 10-Core 3.6GHz LGA1200 (20M Cache, up to 5.20 GHz)
- 27% - Lenovo Legion R27qe IPS Monitor! 2560x1440 / 180Hz / 0.5ms / FreeSync
- AKCIÓ! MacBook Pro 13 M1 8GB RAM 512GB SSD notebook garanciával hibátlan működéssel
- ÚJ HP All in One 24-cr1234na PC - 24"FHD IPS - Ultra 5 125U - 16GB - 512GB SSD - Win11 - Garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest


Fferi50
