VBA Excel: uprava kodu na mazani duplicitnich zaznamu Vyřešeno

[Adalbert]

Jedna se o odmazavani obsahu bunek v pripade, kdy maji dve bunky pod sebou stejne hodnoty.
Tedy jak je videt v kodu, pokud je nad aktualni bunkou bunka s hodnotou shodnou s hodnotou v bunce aktualni ma byt hodnota v aktualni bunce vymazana.

Kód: Vybrat vše

With Worksheets("List1")
Set BlkA = .Range(("m1:m") & .Cells(.Rows.Count, "d").End(xlUp).Row)
End With
 
 
For Each CllA In BlkA.Cells
frstAddr = CllA.Address
Do
  If (CllA.Value) = (CllA.Offset(-1, 0)) Then
  CllA.Value.ClearContents
  End If
Loop While CllA.Address <> frstAddr
Next CllA


bohuzel problem je s nasledujici casti

Kód: Vybrat vše

  If (CllA.Value) = (CllA.Offset(-1, 0)) Then


kdy dochazi k erroru z duvodu, ze pri prvnim provedeni kontroluje neexistujici "nadbunku"

Jak se tomuto vyhnout? Da se postupovat opacne? Tedy prochazet radky od spodu? Jak pak bude vypada kod? Diky

[Reklama]

[m.niki]

zkus to takto

Kód: Vybrat vše

Sub kontrola()
Dim BlkA, CllA As Range

With Worksheets("List1")
Set BlkA = .Range(("m2:m") & .Cells(.Rows.Count, "m").End(xlUp).Row)
End With
 
For Each CllA In BlkA
  If CllA.Value = CllA.Offset(-1, 0).Value Then
  CllA.ClearContents
  End If
Next CllA

End Sub

[Adalbert]

Diky. Taky me to mohlo napadnout .)