-
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
-
bteebi
veterán
Sziasztok!
Írtam egy olyan makrót, amivel egy adott sorban lévő adatokat tudok átmásolni egy másik lap utolsó sorába úgy, hogy az eredeti helyről törlöm őket, vagyis effektíve "archiválom" az adatokat:
Public rwind As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Dim valasz As String, firstemptyrow As Long
If Target.Column = 6 Then
rwind = Target.Row
If Target = "Archiválható" Then
valasz = MsgBox("Szeretnéd archiválni?", vbYesNo, "Archiválás")
If valasz = vbYes Then
firstemptyrow = Sheets("Archivált").Cells(Sheets("Archivált").Rows.Count, 2).End(xlUp).Row + 1
Range(Sheets("Adatok").Cells(Target.Row, 2), Sheets("Adatok").Cells(Target.Row, 6)).Copy Destination:=Sheets("Archivált").Cells(firstemptyrow, 2)
Range(Sheets("Adatok").Cells(Target.Row, 2), Sheets("Adatok").Cells(Target.Row, 6)).Delete Shift:=xlUp
Else: MsgBox "Nem lett archiválva!", vbOKOnly, "Archiválás"
End If
Sheets("Adatok").Cells(rwind, 2).Select
End If
End If
End SubElső közelítésben teljesen jól működik. Két "probléma" van vele: ha megosztom a munkafüzetet (sokan használnák), akkor nem működik az archiválás, mert - gondolom - az "Archivált" lapon nem tudja megtalálni az utolsó sort. Valahogy meg lehetne ezt kerülni?
A másik kérdésem pedig az lenne, hogy hogy lehet olyat csinálni, hogy egy szöveg egy adott ideig (pl. 5 másodpercig) legyen csak kiírva, utána pedig eltűnjön? Ha jól gondolom, akkor ilyet message boxszal sehogy se lehet csinálni.
Előre is köszönöm a javaslatokat!

Új hozzászólás Aktív témák
- Házimozi belépő szinten
- Milyen routert?
- Milyen egeret válasszak?
- AMD Navi Radeon™ RX 9xxx sorozat
- Skoda topik (Favorit és visszafelé)
- Hosszabb bemutatón a Star Trek: Voyager - Across the Unknown
- Videó stream letöltése
- Milyen hagyományos (nem okos-) telefont vegyek?
- Konzolokról KULTURÁLT módon
- Sok hűhó négyszázért: AMD Ryzen 7 9850X3D
- További aktív témák...
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- PC Game Pass előfizetés
- MS SQL Server 2016, 2017, 2019
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Samsung Galaxy A33 5G / 6/128GB / Kártyafüggetlen / 12Hó Garancia
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5700X 16/32/64GB RAM RTX 5060 Ti 16GB GAMER termékbeszámítással
- Referencia Weboldallal Világítós bill+laptop bill magyarítás. Rania 3M -is! Touchpadok is.Posta ok
- Apple iPad Pro 12.9 4.Gen (2020) 94% (1év Garancia) + Ajándék tok
- Eladó Apple iPhone 12 64GB / AKKU 100% / 12 hónap jótállás
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest

Fferi50
