- Asszociációs játék. :)
- Airfryer XL XXL forrólevegős sütő gyakorlati tanácsok, ötletek, receptek
- Fűzzük össze a szavakat :)
- Mindent a StreamSharkról!
- Szólánc.
- Bambanő háza tája
- Nagy "hülyétkapokazapróktól" topik
- Euro Truck Simulator 2 & American Truck Simulator 1 (esetleg 2 majd, ha lesz) :)
- PLEX: multimédia az egész lakásban
- Ingyen kellene, de tegnapra
-
LOGOUT.hu
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
-
#90999040
törölt tag
válasz
hallgat #14111 üzenetére
Azért annyi, mert a cellából/ba olvasás/írás nagyon lassú művelet.
Ha viszont a memóriába olvasod be "tömbként", azon sokkal gyorsabb maga a művelet sebessége, viszont így a memóriahasználat sokkal nagyobb. De hát ugye valamit valamiért.
Még lehetne úgy is, hogy a táblázathoz egy plusz oszlopot átmenetileg hozzáadni, ebben megjelölni a megmaradó cellákat, majd sorba rendezni. Ezután megkeresni ebben az új oszlopban az első nem üres cellát, majd a táblázat sorainak a celláit innentől kezdve törölni. Majd a végén az új oszlop celláit is törölni:
Application.ScreenUpdating = False
Set elsoadat = Range("A2")
Set rng = elsoadat.CurrentRegion
If rng.Row < elsoadat.Row Then Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
n = Cells(Rows.Count, rng.Column).End(xlUp).Row
tomb = Application.Transpose(Range(Cells(rng.Row, rng.Column), Cells(n, rng.Column)).Value)
ReDim tomb1(1 To UBound(tomb))
n = UBound(tomb)
tomb1(n) = 1
For i = n - 1 To 1 Step -1
If tomb(i) <> tomb(n) Then
tomb1(i) = 1
n = i
End If
Next
n = UBound(tomb)
Range(Cells(rng.Row, rng(rng.Count).Column + 1), Cells(rng(rng.Count).Row, rng(rng.Count).Column + 1)).Value = Application.Transpose(tomb1)
Range(Cells(rng.Row, rng.Column), Cells(rng.Row + n - 1, rng(rng.Count).Column + 1)).Sort Key1:=Cells(rng.Row, rng(rng.Count).Column + 1), Order1:=xlDescending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
m = Cells(Rows.Count, rng(rng.Count).Column + 1).End(xlUp).Row
Range(Cells(m + 1, rng.Column), Cells(rng.Row + n - 1, rng(rng.Count).Column + 1)).Delete
Range(Cells(rng.Row, rng(rng.Count).Column + 1), Cells(m, rng(rng.Count).Column + 1)).Delete
Set rng = ActiveSheet.UsedRange
Application.ScreenUpdating = TrueItt a elsoadat-ban kell megadni az első olyan adatot tartalmazó cellát, amelytől lefelé az ismétlődéseket figyelni kell. Előnye, hogy csak egy oszlopot ír(bár 2-t olvas be, valamint autómatikusan érzékeli a fejlécet is, ha a elsoadat jól van megadva, tehát a táblázat igazából bárhol lehet, nem csak az A2-ben.