Avatar billede kristian21 Praktikant
06. september 2014 - 17:23 Der er 8 kommentarer og
1 løsning

Slå dubletter sammen på en linje

Hej,
Jeg har en regneark hvor kolonne 1 består af email-adresser og kolonne 2 består af hvilken mailingliste email-adressen er tilknyttet.

En emailadresse kan i kolonne 1 fremgår flere gange, da emailen kan være tilknyttet flere mail-adresser

eksempel
xxx@xxx.dk    Bøger
xxx@xxx.dk    Blade

Vi skal skifte mail-system, og jeg har derfor brug for at få dupletterne kogt ned på en linje, så første kolonne bliver en unik email og kolonne 2 alle mailinglister.

Eksempel
xxx@xxx.dk  Bøger|Blade

Kan man gøre det på en smart måde?

På forhånd mange tak.
Avatar billede supertekst Ekspert
06. september 2014 - 18:08 #1
En makro kan klare dette automatisk.
Avatar billede kristian21 Praktikant
07. september 2014 - 10:22 #2
Yes. Det er jeg med på. Men jeg mangler en makro der kan gøre det.
Avatar billede jens48 Ekspert
07. september 2014 - 12:04 #3
Prøv med denne lille makro:

Sub MergeDublicates()
LastRow = ActiveSheet.UsedRange.Rows.Count
For x = LastRow To 2 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
Cells(x - 1, 2) = Cells(x - 1, 2) & "/" & Cells(x, 2)
Cells(x, 1).EntireRow.Delete
End If
Next
End Sub
Avatar billede jens48 Ekspert
07. september 2014 - 12:15 #4
Jeg glemte at skrive, at det er en forudsætning at databasen er sorteret.
Avatar billede jens48 Ekspert
07. september 2014 - 12:27 #5
Og uden sortering kunne makroen se sådan ud:

Sub MergeDublicates()
LastRow = ActiveSheet.UsedRange.Rows.Count
Range("A2:B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:B" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For x = LastRow To 2 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
Cells(x - 1, 2) = Cells(x - 1, 2) & "/" & Cells(x, 2)
Rows(x).Delete
End If
Next
End Sub
Avatar billede kristian21 Praktikant
07. september 2014 - 14:12 #6
Det var da fantastisk. Script 1 kørte smurt, og løser mit problem.! Script2 fik jeg en runtime fejl 9 på (Subscript out of range) - blot en note.

Hvis kolonne 3 er virksomhed, kan denne så komme med i sorteringen. (kun hvis du har et quickfix til dette :-)) ellers er det lige meget.

Tusind tak for hjælpen.!
Avatar billede kristian21 Praktikant
07. september 2014 - 14:13 #7
Du må gerne smide et svar. Tak.
Avatar billede jens48 Ekspert
07. september 2014 - 18:42 #8
Hvis du vil have kolonne 3 med i sorteringen skal du blot ændre linie 3 fra
Range("A2:B2").Select
til
Range("A2:C2").Select

Jeg kan ikke lige se hvorfor du får runtime fejl 9.
Avatar billede kristian21 Praktikant
08. september 2014 - 08:49 #9
Det spiller. Eneste problem i script2 var navngivningen på fanen. Da jeg rettede dette, virkede det også.

Det er simpelthen godt lavet af dig :-) Jeg er imponeret.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester