PHP.EE FOORUM   
Nimi:   Pass:   Mäleta mind! 
   Teemad | php.ee esilehele | registreeri | Märgi kõik teemad loetuks | #php.ee Skype vestlus | RSS
UUS TEEMA  OTSI  Lehekülgi: 1
Excel VBA modimine
Postitaja: VBA 2016-01-08 00:26:10
Mul on VBA mis tuvastab ära sarnased dublikaadid A veerus. Sarnase vaste korral teeb märke B veergu.
Antud VBA töötab hetkel ainult sõnade puhul, kuidas seda saaks muuta nii, et see suudaks tuvastada numbreid, mis asuvad A lahtris.
Numbrid pikkuseks on 7-9

Näide:
43847392
506940392
3595030
...


Sub duplicates()

Dim OCell As Range, ProductInfo As Range

Dim FirstAddress As String

Dim i As Integer, u As Integer, ProdCount As Integer

Application.ScreenUpdating = False



u = 1

Range("A:A").Activate

With ActiveSheet



Do Until ActiveCell = ""



If ActiveCell.Offset(0, 1) <> "" Then

Do

ActiveCell.Offset(1, 0).Activate

Loop Until ActiveCell.Offset(0, 1) = ""



FirstAddress = ActiveCell.Address

Range(FirstAddress).Activate

End If



Set ProductInfo = ActiveCell

FirstAddress = ActiveCell.Address



With .Columns("A:A")

ProdCount = WorksheetFunction.CountIf(.Columns("A:A"), ProductInfo)



If ProdCount > 1 Then

Set OCell = .Find(ProductInfo.Value, LookAt:=xlWhole)

OCell.Activate

ActiveCell.Offset(0, 1) = u

For i = 1 To ProdCount - 1

Set OCell = .FindNext(OCell)

OCell.Activate

ActiveCell.Offset(0, 1) = u

Next i

u = u + 1

Else

Range(FirstAddress).Offset(1, 0).Activate

End If

End With

10



Set OCell = Nothing

ProdCount = 0

Range(FirstAddress).Offset(1, 0).Activate

Loop

End With

Range("A:A").Select

Application.CutCopyMode = False

Application.ScreenUpdating = True

Set ProductInfo = Nothing

Set OCell = Nothing

End Sub

Leheküljed: 1

©2002-2013 Martin Rebane & PHP.ee kaasautorid
  0.082661151886