Hirdetés
- lezso6: Miért is jó, ha dohányzol?! Megéri rászokni!
- sziku69: Fűzzük össze a szavakat :)
- Brogyi: CTEK akkumulátor töltő és másolatai
- eBay-es kütyük kis pénzért
- ubyegon2: Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- sparks: 15 év droid után iPhone tapasztalat, 7 nap alatt
- Pajac: PassMark - Intel Atom D2700
- ricshard444: Iphone 17 Pro Max - Kedves téglám
- urandom0: Kicsit most elfáradtam...
- MasterDeeJay: MSI H110M PRO és i3-8350K (coffeetime mod)
-
LOGOUT
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
- VGA kibeszélő offtopik
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Elektromos autók - motorok
- One otthoni szolgáltatások (TV, internet, telefon)
- lezso6: Miért is jó, ha dohányzol?! Megéri rászokni!
- sziku69: Fűzzük össze a szavakat :)
- World of Warships
- Xbox tulajok OFF topicja
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Apple iPhone 17 Pro Max – fennsík
- További aktív témák...
- Eredeti - Choice - Bundle - Steam kulcsok beszerzése. Írj kérés PM-et!
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Antivírus szoftverek, VPN
- AKCIÓ! Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával - Nint.hu
- LG SN4 soundbar hangprojektor 6 hó garancia, számlával!
- Kezdő Gamer PC-Számítógép! Csere-Beszámítás! I5 7500 / GTX 1050Ti / 16GB DDR4 / 128SSD+1TB HDD
- BESZÁMÍTÁS! Apple iPhone 16 Pro MAX 256GB okostelefon garanciával hibátlan működéssel
- Acer TravelMate P214 i3-1115G4 12GB 256GB 14" FHD 1év garancia
- LG 27UL500-W - 27" IPS - 3840x2160 4K - 60Hz 5ms - HDR10 - AMD FreeSync - 300 Nits - sRGB 99%
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest