Excel makro pähkinä

Koitetaampas kuvata paremmin. eli tuo taulukko alkaa solusta A1, siinä Nro: ja B1:ssä Rivi: ja tiedot alla. Alaviivat vain tuossa että näyttäs taulukolta kun muuten sotki asettelut.

Ja onkelmaan.
Eli tarkoitus olis käydä tuota taulukkoa läpi siten että Nro:n dupilikaatit poistetaan. Nro:han sarakkeessaan on kahteen kertaan eli se on tietyn Rivi: joukon alussa ja lopussa ja välissä tyhjiä soluja nolla tai enempi. Nro voi olla vain yhdenkin kerran jos vain yksi rivi ja missä kohden vain. Pois pitäisi saada jälkimmäinen Nro:. esimerkissä poistuisi 71314 riviltä 2, 71548 riviltä 8, 72394 riviltä 14 ja 72395 viimeiseltä riviltä. Nro: solun arvo tyhjennetään, riviä ei poisteta.

Sain ite pelaamaan osittain. Eka ja viimeinen rivi myös muistettava hanskata jos niissä yksittäisarvo. niitä voi olla myös yksi tai useampi peräkkäin, alussa, lopussa tai keskellä.

Jos vielä jäi jotain epäselväks niin kysäse. Tässä taulukossa on variaatioita nii pirusti.

__A______B
.Nro:___Rivi:
71314 00026
71314 00035
71548 00654
______00655
______00656
______00657
______00658
71548 00001
72127 00001
72128 00001
72394 00001
______00002
______00020
72394 00021
72395 00001
______00002
______00020
72395 00021

Teijjo kirjoitti:

Koitetaampas kuvata paremmin. eli tuo taulukko alkaa solusta A1, siinä Nro: ja B1:ssä Rivi: ja tiedot alla. Alaviivat vain tuossa että näyttäs taulukolta kun muuten sotki asettelut.

Ja onkelmaan.
Eli tarkoitus olis käydä tuota taulukkoa läpi siten että Nro:n dupilikaatit poistetaan. Nro:han sarakkeessaan on kahteen kertaan eli se on tietyn Rivi: joukon alussa ja lopussa ja välissä tyhjiä soluja nolla tai enempi. Nro voi olla vain yhdenkin kerran jos vain yksi rivi ja missä kohden vain. Pois pitäisi saada jälkimmäinen Nro:. esimerkissä poistuisi 71314 riviltä 2, 71548 riviltä 8, 72394 riviltä 14 ja 72395 viimeiseltä riviltä. Nro: solun arvo tyhjennetään, riviä ei poisteta.

Sain ite pelaamaan osittain. Eka ja viimeinen rivi myös muistettava hanskata jos niissä yksittäisarvo. niitä voi olla myös yksi tai useampi peräkkäin, alussa, lopussa tai keskellä.

Jos vielä jäi jotain epäselväks niin kysäse. Tässä taulukossa on variaatioita nii pirusti.

__A______B
.Nro:___Rivi:
71314 00026
71314 00035
71548 00654
______00655
______00656
______00657
______00658
71548 00001
72127 00001
72128 00001
72394 00001
______00002
______00020
72394 00021
72395 00001
______00002
______00020
72395 00021

Jos on kysymys pelkästään dublikaattien poistosta sarakkeesta "A" niin tässä yksi ehdotus:

Esimerkissäsi oli 18 riviä ja se on laitettu vakioon.

Sub Dulbl()
Dim I As Long
Dim J As Long
Const Pituus As Long = 18
For I = 1 To Pituus - 1
For J = I 1 To Pituus
If Cells(I, 1).Value = Cells(J, 1) Then Cells(J, 1).Clear
Next J
Next I
End Sub

ihan tosissaan kirjoitti:

Jos on kysymys pelkästään dublikaattien poistosta sarakkeesta "A" niin tässä yksi ehdotus:

Esimerkissäsi oli 18 riviä ja se on laitettu vakioon.

Sub Dulbl()
Dim I As Long
Dim J As Long
Const Pituus As Long = 18
For I = 1 To Pituus - 1
For J = I 1 To Pituus
If Cells(I, 1).Value = Cells(J, 1) Then Cells(J, 1).Clear
Next J
Next I
End Sub

Ehdotuksesi pelaa hienosti ainut että siinä on aika paljon "kierroksia". Jos taulukkossa on tuhansia rivejä niin pyörii jonkin verran. Alla meikäläisen tekele. Ajatuksena että yhdellä luuppauksella koko taulukko läpi. toki ehdotustasi voi helposti muuttaa siten että kun poisto tapahtuu siirrytään eteenpäin. Kiitos vain efordista, koodisi tallessa ja oppi myös tulevaisuutta varten.

Sub poistaorderno()
Dim I As Integer
Dim Solu As String

I = 2
Solu = Cells(I, 1).Value
Do While Cells(I, 2).Value ""
If Cells(I 1, 1) Solu And Cells(I 1, 1) "" Then
I = I 1
Solu = Cells(I, 1).Value
End If

If Cells(I 1, 1) = "" Then
I = I 1
End If

If Cells(I 1, 1) = Solu Then
I = I 1
Range("A" & I).Select
Selection.Clear
I = I 1
Solu = Cells(I, 1).Value
End If
Loop
End Sub

Teijjo kirjoitti:

Ehdotuksesi pelaa hienosti ainut että siinä on aika paljon "kierroksia". Jos taulukkossa on tuhansia rivejä niin pyörii jonkin verran. Alla meikäläisen tekele. Ajatuksena että yhdellä luuppauksella koko taulukko läpi. toki ehdotustasi voi helposti muuttaa siten että kun poisto tapahtuu siirrytään eteenpäin. Kiitos vain efordista, koodisi tallessa ja oppi myös tulevaisuutta varten.

Sub poistaorderno()
Dim I As Integer
Dim Solu As String

I = 2
Solu = Cells(I, 1).Value
Do While Cells(I, 2).Value ""
If Cells(I 1, 1) Solu And Cells(I 1, 1) "" Then
I = I 1
Solu = Cells(I, 1).Value
End If

If Cells(I 1, 1) = "" Then
I = I 1
End If

If Cells(I 1, 1) = Solu Then
I = I 1
Range("A" & I).Select
Selection.Clear
I = I 1
Solu = Cells(I, 1).Value
End If
Loop
End Sub

Tässä yksinkertainen tapa, joka perustuu siihen, että kun lisätään jäseniä kokoelmaan se hyväksyy vain ainutkertaiset arvot ja jos syötetään tupla-arvo niin se palauttaa virheen,jota käytetään hyväksi...


Sub PoistaTuplat()
Dim cell As Range
Dim Vika As Double
Dim EiTupla As New Collection
On Error GoTo virhe
Vika = Range("A65536").End(xlUp).Row
For Each cell In Range("A1:A" & Vika)
If Not IsEmpty(cell) Then
EiTupla.Add cell.Value, CStr(cell.Value)
End If
Next cell
Exit Sub
virhe:
cell.Clear
Resume Next
End Sub

Kunde kirjoitti:

Tässä yksinkertainen tapa, joka perustuu siihen, että kun lisätään jäseniä kokoelmaan se hyväksyy vain ainutkertaiset arvot ja jos syötetään tupla-arvo niin se palauttaa virheen,jota käytetään hyväksi...


Sub PoistaTuplat()
Dim cell As Range
Dim Vika As Double
Dim EiTupla As New Collection
On Error GoTo virhe
Vika = Range("A65536").End(xlUp).Row
For Each cell In Range("A1:A" & Vika)
If Not IsEmpty(cell) Then
EiTupla.Add cell.Value, CStr(cell.Value)
End If
Next cell
Exit Sub
virhe:
cell.Clear
Resume Next
End Sub

Tämä on jotenkin hemmetin tyylikäs vaihtoehto. Mielenkiintoista miten monilla eri tavoilla saman asian voi tehdä. Minulla on tunne että tätä ja sen variaatioita tulen käyttämään kunhan tutustun tuohon collectioniin tarkemmin. Noita isojen listojen läpikäyntejä nääs piisaa. Pitää vain testata miten raskas tuollainen collectioni on kun siinä alkaa olla reilut 20000 entryä.

Kunde kirjoitti:

Tässä yksinkertainen tapa, joka perustuu siihen, että kun lisätään jäseniä kokoelmaan se hyväksyy vain ainutkertaiset arvot ja jos syötetään tupla-arvo niin se palauttaa virheen,jota käytetään hyväksi...


Sub PoistaTuplat()
Dim cell As Range
Dim Vika As Double
Dim EiTupla As New Collection
On Error GoTo virhe
Vika = Range("A65536").End(xlUp).Row
For Each cell In Range("A1:A" & Vika)
If Not IsEmpty(cell) Then
EiTupla.Add cell.Value, CStr(cell.Value)
End If
Next cell
Exit Sub
virhe:
cell.Clear
Resume Next
End Sub

Täytyy pitää idea mielessä jos joskus tarvitsisi soveltaa. Hyvä!