Új hozzászólás Aktív témák

• #14113 #90999040 törölt tag hallgat #14111

  Új Válasz 2012-06-23 18:53:41 #14113

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  #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 = True

  Itt 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.

Új hozzászólás Aktív témák