26. august 2006 - 15:43Der er
41 kommentarer og 1 løsning
Fjern dubletter
Jeg har et regneark med ca. 7.000 rækker og 3 kolonner. Her er der nogle rækker der går igen 2-3 gange. Dem vil jeg gerne have fjernet uden at skulle slette dem enkeltvis.
Rækkerne kan se sådan her ud A B C :
Østrig Akademie Der Bildenden Künste Wien Wien Østrig Akademie Der Bildenden Künste Wien Wien Østrig Akademie Fûr Den Physiotherapeut... Wien
Her vil jeg gerne have at den sletter dubletterne. Disse står ikke altid lige efter hianden.
Jeg kunne også godt tænke mig at den automatisk slettede det sidste ord i kollonne B hvis det er magen til C. Således at der ikke står Wien Wien.
Hvis ordet i C er på 7 bogstaver, så må den gerne sætte et punktum bagefter da ordet så sandsynligvis er forkortet.
Hvis kolonne D er ledig så prøv denne makro den sletter evt. dubletter Husk at lave en backup først.
Sub SletDubletter() Dim c, r, t, t2, i, rk rk = Range("A65500").End(xlUp).Row For i = 1 To rk Cells(i, 4) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) Next Cells(1, 4).Select c = ActiveCell.Column r = Cells(65500, c).End(xlUp).Row Range(Cells(1, c), Cells(65500, c).End(xlUp)).Select For t = 1 To r If Cells(t, c) <> "" Then For t2 = t + 1 To r If Cells(t, c) = Cells(t2, c) Then Cells(t2, c) = "" End If Next End If Next On Error Resume Next Selection.Columns.SpecialCells(xlCellTypeBlanks).EntireRow.Delete Range("D1:D65500") = "" Range("A1").Select End Sub
og denne sletter navn i B hvis=C samt punktum i C hvis <=7 tegn.
Sub Split() Dim rk, r, l rk = Range("A65500").End(xlUp).Row For r = 1 To rk l = Len(Cells(r, 3)) If Right(Cells(r, 2), l) = Cells(r, 3) Then Cells(r, 2) = Left(Cells(r, 2), Len(Cells(r, 2)) - l) End If If Len(Cells(r, 3)) < 7 Then Cells(r, 3) = Cells(r, 3) & "." Next End Sub
Sub SletDubletter() Dim c, r, t, t2, i, rk, l rk = Range("A65500").End(xlUp).Row For i = 1 To rk Cells(i, 4) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) Next Cells(1, 4).Select c = ActiveCell.Column r = Cells(65500, c).End(xlUp).Row Range(Cells(1, c), Cells(65500, c).End(xlUp)).Select For t = 1 To r If Cells(t, c) <> "" Then For t2 = t + 1 To r If Cells(t, c) = Cells(t2, c) Then Cells(t2, c) = "" End If Next End If Next On Error Resume Next Selection.Columns.SpecialCells(xlCellTypeBlanks).EntireRow.Delete Range("D1:D65500") = "" rk = Range("A65500").End(xlUp).Row For r = 1 To rk l = Len(Cells(r, 3)) If Right(Cells(r, 2), l) = Cells(r, 3) Then Cells(r, 2) = Left(Cells(r, 2), Len(Cells(r, 2)) - l) End If If Len(Cells(r, 3)) <= 7 Then Cells(r, 3) = Cells(r, 3) & "." Next Range("A1").Select End Sub
Jeg kunne ikke få det til at virke. Eller det vil sige min PC døde :D Prøver igen, men vil lige høre om dette her er muligt
England University Of East London London England University Of Edinburgh Edinbur England University Of Edinburgh Edinbur England University Of Essex Colches
Her ses det at navnet i C er forkortet. Kan man lave det sådan at Navn i C forsvinder hvis det udgør en del af sidste ord i B ?
Sub SletDubletter() Dim c, r, t, t2, i, rk, l, lb, lc Application.Calculation = xlManual Application.ScreenUpdating = False rk = Range("A65500").End(xlUp).Row For i = 1 To rk Cells(i, 4) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) Next Cells(1, 4).Select c = ActiveCell.Column r = Cells(65500, c).End(xlUp).Row Range(Cells(1, c), Cells(65500, c).End(xlUp)).Select For t = 1 To r If Cells(t, c) <> "" Then For t2 = t + 1 To r If Cells(t, c) = Cells(t2, c) Then Cells(t2, c) = "" End If Next End If Next On Error Resume Next Selection.Columns.SpecialCells(xlCellTypeBlanks).EntireRow.Delete Range("D1:D25500") = "" rk = Range("A65500").End(xlUp).Row For r = 1 To rk lb = Len(Cells(r, 2)): lc = Len(Cells(r, 3)) For i = 1 To lb If Mid(Cells(r, 2), i, 1) = " " Then t = i Next Cells(r, 5) = Mid(Cells(r, 2), t + 1, 20) If Left(Cells(r, 5), 4) = Left(Cells(r, 3), 4) And Len(Cells(r, 5)) >= lc Then Cells(r, 3) = "" If Len(Cells(r, 3)) <= 7 And Right(Cells(r, 3), 1) <> "." And Cells(r, 3) <> "" Then Cells(r, 3) = Cells(r, 3) & "." End If Next Range("E1:E25500") = "" Application.ScreenUpdating = True Application.Calculation = xlAutomatic Range("A1").Select End Sub
din kommentar 26/08-2006 18:07:40 Her ses det at navnet i C er forkortet. Kan man lave det sådan at Navn i C forsvinder hvis det udgør en del af sidste ord i B ? ???
min kørsel på: England |University Of Kent At Canterbury |Canterb giver: England |University Of Kent At Canterbury
Østrig Akademie Der Bildenden Künste Wien Wien Østrig Akademie Der Bildenden Künste Wien Wien Østrig Akademie Fûr Den Physiotherapeut… Wien England University Of East London London England University Of Edinburgh Edinbur England University Of Edinburgh Edinbur England University Of Essex Colches England University Of Kent At Canterbury Canterb
Når jeg har kopieret ovenstående 8 linier, så jeg har 10.000 rækker tager en kørsel 14 sekunder
og du har ret, den ændrer ikke England University Of Cambridge Cambrid det ser ud til, at hele kolonne B har et tomt mellemrum i alle navne sidst i teksten, hvilket er årsag til omtalte problem. Det skal vi nu nok finde en løsning på, det mest iriterende er dog at den er så længe om at lave en kørsel, så det vil jeg lige se om ikke kan løses
Med dit kendskab til listen, ved du om man evt. kunne nøjes med at teste på kolonne B for at finde dubletter, dette alene vil speede tempoet op en del?
Indsæt denne formel i celle D2 =FJERN.OVERFLØDIGE.BLANKE(B2) marker celle D2 igen og træk ned til hvor værdier ender (række 9385) (dette laver en kopi af kolonne B uden det sidste tomme mellemrum) klik på kopi ikon klik på pil i paste ikon og vælg indsæt værdier træk hele det markerede i kolonne D over i kolonne B og slip
Jeg er ikke 100% sikker på at test på B er sikkert :-/ Jeg tror der måske er fx universitet der hedder det samme som ligger i flere lande. Men B og C sammen er sikker.
Hastigheden kan fordobles, hvis følgende forudsætning er til stede. eks. Østrig forekommer fra række 2 til række 437. Hvis man kan regne med, de enkelte lande er samlet i hele listen, så behøver vi kun køre en løkke med 2600, ide Frankrig forekommer ca 2500 gange Umiddelbart ser det ud til at det er tilfældet, men man kunne evt. Sortere listen efter kolonne A for at være sikker. ved ikke hvor vigtig hastigheden er?
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.
