[es] - nalazenje duplikata i kopiranje vrednosti u prvi red a brisanje ostalih

gogi100
Goran Ljubic

Član broj: 40722
Poruke: 1064
*.mediaworksit.net.

+3 Profil

nalazenje duplikata i kopiranje vrednosti u prvi red a brisanje ostalih

^{29.08.2012. u 12:58 - pre 141 meseci}

dakle imam tabelu koju sam zakacio uz poruku.
pre primene ovog makroa:

Code:
Sub deleteduplicate()
'define variables
Dim RowNum As Long
Dim LastRow As Long
Dim i As Integer
Dim j As Integer
'turn off screen updating
Application.ScreenUpdating = False
'start below titles and make full selection of data
RowNum = 2
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A5", Cells(LastRow, 8)).Select

'For loop for all rows in selection with cells
For Each Row In Selection
    With Cells

           For i = 2 To 8
           For j = 1 To 500
           If Cells(RowNum, 1) = Cells(RowNum + j, 1) Then
           If IsEmpty(Cells(RowNum, i)) Then
           If IsEmpty(Cells(RowNum + j, i)) Then
           Cells(RowNum, i).Value = ""
           Else
           Cells(RowNum + j, i).Copy Destination:=Cells(RowNum, i)
            Rows(RowNum + j).EntireRow.Delete
            End If
            End If
            End If

            Next
            Next

   End With
'increase rownum for next test
RowNum = RowNum + 1
Next Row
'turn on screen updating
Application.ScreenUpdating = True

End Sub

tabela izgleda kao u sheetu2
kad se makro primeni tabela izgleda kao u sheetu1.
makro radi kad se radi o tabeli sa mali broj redova do 30-30. medjutim kad su u pitanju redovi od 100 pa na gore
onda ne radi. excel se zaglupi i nista se ne desava.
u cemu je problem?

Prikačeni fajlovi

Book1.xlsx - 9.46k

Odgovor na temu