-
IT café
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 #14093 üzenetére
Próbáld meg így:
n = Range("A" & Rows.Count).End(xlUp).Row
For i = n - 1 To 1 Step -1
If Cells(i, 1).Value <> Cells(n, 1).Value Then
If i < n - 1 Then Rows(i + 1 & ":" & n - 1).Delete
n = i
End If
Next
If Cells(1, 1).Value = Cells(n, 1).Value And n > 1 Then Rows(1 & ":" & n - 1).Delete -
cousin333
addikt
válasz hallgat #14093 üzenetére
Mindenképpen az egész sor törlése kell, nem csak egy adott mennyiségű oszlopé?
A sebesség azért lassú, mert sokszor nyúlsz a cellákhoz. Ilyen adatmennyiségnél ez már komoly problémát jelent.
Azt írtad, hogy az ismétlődések csak egymás után fordulnak elő. Akkor egyszerűen menj végig az oszlopon, és ha az aktuális cella megegyezik az előző cellával, akkor töröld ki az adott sort. Csak arra figyelj, hogy legközelebb is ugyanezt a sort vizsgáld, mert a törlés miatt eggyel kevesebb lett. Vagy alulról indulj el felfelé.
[ Szerkesztve ]
"We spared no expense"
-
cousin333
addikt
válasz hallgat #14093 üzenetére
Na, megalkottam a gyilkos VBA kódot Nyilván lehetne még rajta reszelni, de úgy tűnik, működik, méghozzá elég gyorsan. A kód feltételezi, hogy a kérdéses számok az A1:A20000-es tartományban vannak. Akkor is így kell megadni, ha a számok csak a 2. sorban kezdődnek! Ha nem az első sorból indítasz, akkor módosítgatni kell a kódot, mert nálam a tartomány indexe és a sor száma ugyanaz (lásd a For ciklust).
Gyakorlatilag megnézem a teljes listát, és ha azonosat találok, megjelölöm azzal, hogy törlöm a mellette(!) lévő cella tartalmát (különben csak minden 2. egyezést találna meg). A törlést nem a munkafüzeten végzem, mert az ennyi adatnál lassú lenne, hanem "belsőleg".
Ezután fogom a teljes tartományt, és kijelölöm illetve törlöm azokat a sorokat, amiben a B cella üres. A kód:
Sub duplikatum()
Dim szamok As Variant
szamok = Range("A1:B20000").Value
sorok = ""
For i = 2 To UBound(szamok)
If szamok(i, 1) = szamok(i - 1, 1) Then
szamok(i, 2) = ""
End If
Next i
Range("A1:B20000").Value = szamok
Range("B1:B20000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub[ Szerkesztve ]
"We spared no expense"
Új hozzászólás Aktív témák
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen