-
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
- Star Trek Online -=MMORPG=-
- Kutya topik
- Okos otthon - Home Assistant, openHAB és más nyílt rendszerek
- Vezeték nélküli fejhallgatók
- Házimozi belépő szinten
- Milyen billentyűzetet vegyek?
- Egyre inkább szoftverrel segítene a Core CPU-k teljesítményén az Intel
- Vezetékes FEJhallgatók
- OLED monitor topic
- TCL LCD és LED TV-k
- További aktív témák...
- Tablet felvásárlás!! Samsung Galaxy Tab A8, Samsung Galaxy Tab A9, Samsung Galaxy Tab S6 Lite
- 171 - Lenovo Legion Pro 7 (16IAX10H) - Intel Core U9 275HX, RTX 5080 (ELKELT)
- Lenovo T490S i5 8365U, 16GB RAM, 256GB SSD, jó akku, számla, 6 hó gar
- Apple iPhone 11 Pro Max 64GB,Újszerű,Adatkabel,12 hónap garanciával
- ÚRIS10!!! RAMÁRON! LEGION 5 i7-13650HX 16GB RAM 512GB SSD RTX 5070 8GB
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50