-
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
- Okos otthon - Home Assistant, openHAB és más nyílt rendszerek
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Milyen routert?
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- Genshin Impact (PC, PS4, Android, iOS)
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Dell notebook topic
- Projektor topic
- További aktív témák...
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Microsoft és egyéb dobozos és OEM szoftverek
- HP. Laptop. i5. Model: 15-da1002nq
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Eladó/BONTATLAN Lenovo LOQ i7-13650HX 24GB 1TB RTX 4060 8GB
- Apple iPhone 12 64GB,Használt,Adatkabel,12 hónap garanciával
- 15,6" Dell Latitude laptopok: E5550, E5570, 5590, 5500, 5501, 5510, 5520 / SZÁMLA + GARANCIA
- HIBÁTLAN iPhone 15 128GB Yellow-1 ÉV GARANCIA - Kártyafüggetlen, MS4489, 100% Akksi
- Lenovo Thinpad üzleti kategóriás notebookok - i5 - i7 - Ryzen - nagy választékban számlával - 04.25
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50