Duplikaattien poisto

Kaikki tekstit ovat omissa sarakkeissaan samalla rivillä esim. 1,2,4,3,2,3,1... jne. Eli ei missään järjestyksessä vaan täysin randomisti. Nyt sieltä välistä pitäisi vaan saada ne ylimääräiset tekstit pois ja myöskin niiden sarakkeet poistettua.
Esim.

Kyllä , Ei , Ehkä , Mahdollisesti , Kyllä , Mahdollisesti, Ehkä , Ei , Kyllä , Ei Mahdollisesti , Ehkä , Ehkä , Kyllä , Mahdollisesti, Ei
Muotoon
Kyllä , Ei , Ehkä , Mahdollisesti

Kiitoksia vaan avusta jo etukäteen

apua vailla kirjoitti:

Kaikki tekstit ovat omissa sarakkeissaan samalla rivillä esim. 1,2,4,3,2,3,1... jne. Eli ei missään järjestyksessä vaan täysin randomisti. Nyt sieltä välistä pitäisi vaan saada ne ylimääräiset tekstit pois ja myöskin niiden sarakkeet poistettua.
Esim.

Kyllä , Ei , Ehkä , Mahdollisesti , Kyllä , Mahdollisesti, Ehkä , Ei , Kyllä , Ei Mahdollisesti , Ehkä , Ehkä , Kyllä , Mahdollisesti, Ei
Muotoon
Kyllä , Ei , Ehkä , Mahdollisesti

Kiitoksia vaan avusta jo etukäteen

Lue lisää

oletuksena, että sarakkeessa A on tietoa...

moduuliin ...

Sub PoistaTuplatRiviltä()
Dim Solu As Range
Dim Alue As Range
On Error Resume Next

Range("A1").Select
Do Until ActiveCell = ""
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 255).End(xlToLeft))
For Each Solu In Alue
If WorksheetFunction.CountIf(Alue, Solu) > 1 Then
Solu.Clear
End If
Next Solu
Alue.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
ActiveCell.Offset(1, 0).Select
Loop
End Sub

kunde kirjoitti:

oletuksena, että sarakkeessa A on tietoa...

moduuliin ...

Sub PoistaTuplatRiviltä()
Dim Solu As Range
Dim Alue As Range
On Error Resume Next

Range("A1").Select
Do Until ActiveCell = ""
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 255).End(xlToLeft))
For Each Solu In Alue
If WorksheetFunction.CountIf(Alue, Solu) > 1 Then
Solu.Clear
End If
Next Solu
Alue.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Lue lisää

Kiitoksia avusta.

Ei kyllä vielä toimi ihan täysin. Olen amatööri näitten VBA koodien kanssa, sain kyllä ajettua sen moduuliin ja makron ajettua mutta, se toimii nyt vain yhden sarakkeen osalla. Sen pitäisi ajaa rivi kerrallaan 12 tekstin osalta noin 250 riviä.
Koitan vielä itse tutkia asiaa mutta kun ei ole mitään kokemusta näistä niin mielellään otan neuvoja vastaan vielä.
Eli tiedot L3-W3 pitäisi käsitellä L246-W246 asti. Näistä kun saisi kerättyä ne tiedot...

kiitoksia vastauksista

Avun tarpeessa kirjoitti:

Kiitoksia avusta.

Ei kyllä vielä toimi ihan täysin. Olen amatööri näitten VBA koodien kanssa, sain kyllä ajettua sen moduuliin ja makron ajettua mutta, se toimii nyt vain yhden sarakkeen osalla. Sen pitäisi ajaa rivi kerrallaan 12 tekstin osalta noin 250 riviä.
Koitan vielä itse tutkia asiaa mutta kun ei ole mitään kokemusta näistä niin mielellään otan neuvoja vastaan vielä.
Eli tiedot L3-W3 pitäisi käsitellä L246-W246 asti. Näistä kun saisi kerättyä ne tiedot...

kiitoksia vastauksista

Lue lisää

ohjeissa mainitsin
oletuksena, että sarakkeessa A on tietoa...

no fiksasin sen sarakkeelle L

Sub PoistaTuplatRiviltä()
Dim Solu As Range
Dim Alue As Range
On Error Resume Next

Range("L3").Select
Do Until ActiveCell = ""
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 244).End(xlToLeft))
For Each Solu In Alue
If WorksheetFunction.CountIf(Alue, Solu) > 1 Then
Solu.Clear
End If
Next Solu
Alue.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
ActiveCell.Offset(1, 0).Select
Loop
End Sub

kunde kirjoitti:

ohjeissa mainitsin
oletuksena, että sarakkeessa A on tietoa...

no fiksasin sen sarakkeelle L

Sub PoistaTuplatRiviltä()
Dim Solu As Range
Dim Alue As Range
On Error Resume Next

Range("L3").Select
Do Until ActiveCell = ""
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 244).End(xlToLeft))
For Each Solu In Alue
If WorksheetFunction.CountIf(Alue, Solu) > 1 Then
Solu.Clear
End If
Next Solu
Alue.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Lue lisää

Loistavaa!

Ehdin kyllä vaihtamaan sen jo L3:seen mutta ei vaan lähtenyt jostain syystä toimimaan.
Nyt toimii ja hienosti.
Kiitoksia säästit multa kyllä vähintään tuhannen ärräpäätä.
Hienoa kun jaksoit auttaa ja vastailla!!!

Apua jo saanut kirjoitti:

Loistavaa!

Ehdin kyllä vaihtamaan sen jo L3:seen mutta ei vaan lähtenyt jostain syystä toimimaan.
Nyt toimii ja hienosti.
Kiitoksia säästit multa kyllä vähintään tuhannen ärräpäätä.
Hienoa kun jaksoit auttaa ja vastailla!!!

Lue lisää

piti siinä fiksata toinenkin rivi...
sarake A
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 255).End(xlToLeft))

sarake L
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 244).End(xlToLeft))

kunde kirjoitti:

piti siinä fiksata toinenkin rivi...
sarake A
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 255).End(xlToLeft))

sarake L
Set Alue = Range(ActiveCell, ActiveCell.Offset(0, 244).End(xlToLeft))

Lue lisää

Kiitos vaan vielä kerran.
Käsipelin tossa on menny ennen muutama päivä, nyt kun saatiin tiedot exceliin ja vielä tollanen makro niin johan nopeutus hommat.