- One mobilszolgáltatások
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Honor 200 - kétszázért pont jó lenne
- Milyen okostelefont vegyek?
- iPhone topik
- Mobil flották
- Samsung Galaxy A55 - új év, régi stratégia
- Bemutatkozott a Poco X7 és X7 Pro
- Xiaomi 15 - kicsi telefon nagy energiával
- Xiaomi 13 - felnőni nehéz
-
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
- Revolut
- Óra topik
- Milyen egeret válasszak?
- Ingatlanos topic!
- Témázgatunk, témázgatunk!? ... avagy mutasd az Android homescreened!
- Futás, futópályák
- PlayStation 5
- Mielőbb díjat rakatnának a görögök az olcsó csomagokra az EU-ban
- Modding és elektronikai kérdések
- Rágyúr a macOS-re a 3DMark
- További aktív témák...
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Új, bontatlan World of Warcraft gyűjtői kiadások
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Giant Talon 0 Sport - Hardtail Mountain Bike
- ÁRGARANCIA!Épített KomPhone Ryzen 7 9800X3D 32/64GB RAM RTX 5070Ti 16GB GAMER PC termékbeszámítással
- Bomba ár! Lenovo ThinkPad T460 - i5-6GEN I 8GB I 256SSD I 14" FHD I Cam I W10 I Garancia!
- AKCIÓ! Gigabyte B450M R7 2700X 16GB DDR4 512GB SSD RX VEGA64 8GB CM 690 III FSP 600W
- LG 45GS95QE - 45" Ívelt OLED / 2K WQHD / 240Hz 0.03ms / NVIDIA G-Sync / FreeSync Premium / HDMI 2.1
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: Promenade Publishing House Kft.
Város: Budapest